#!/usr/local/bin/perl
use Config;
use File::Basename qw(&basename &dirname);
use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries. Thus you write
# $startperl
# to ensure Configure will look for $Config{startperl}.
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.
print OUT <<"!GROK!THIS!";
$Config{'startperl'}
eval 'exec perl -S \$0 "\$@"'
if 0;
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
#
# buildtoc
#
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# This file is autogenerated by buildtoc.PL.
# Edit that file and run it to effect changes.
#
# Builds perltoc.pod and sanity checks the list of pods against all
# of the MANIFEST, perl.pod, and ourselves.
#
use File::Find;
use Cwd;
use Text::Wrap;
@PODS = glob("*.pod");
sub output ($);
if (-d "pod") {
die "$0: failed to chdir('pod'): $!\n" unless chdir("pod");
}
@pods = qw(
perl
perlfaq
perltoc
perlbook
perlsyn
perldata
perlop
perlsub
perlfunc
perlreftut
perldsc
perlrequick
perlpod
perlstyle
perltrap
perlrun
perldiag
perllexwarn
perldebtut
perldebug
perlvar
perllol
perlopentut
perlretut
perlre
perlref
perlform
perlboot
perltoot
perltootc
perlobj
perlbot
perltie
perlipc
perlfork
perlnumber
perlthrtut
perlport
perllocale
perlunicode
perlebcdic
perlsec
perlmod
perlmodlib
perlmodinstall
perlnewmod
perlfaq1
perlfaq2
perlfaq3
perlfaq4
perlfaq5
perlfaq6
perlfaq7
perlfaq8
perlfaq9
perlcompile
perlembed
perldebguts
perlxstut
perlxs
perlguts
perlcall
perlutil
perlfilter
perldbmfilter
perlapi
perlintern
perlapio
perltodo
perlhack
perlhist
perldelta
perl56delta
perl5005delta
perl5004delta
perlamiga
perlcygwin
perldos
perlhpux
perlmachten
perlos2
perlos390
perlposix-bc
perlvms
perlwin32
);
@ARCHPODS = qw(
perlamiga
perlcygwin
perldos
perlhpux
perlmachten
perlos2
perlos390
perlposix-bc
perlvms
perlwin32
);
for (@ARCHPODS) { s/$/.pod/ }
@ARCHPODS{@ARCHPODS} = ();
for (@pods) { s/$/.pod/ }
@pods{@pods} = ();
@PODS{@PODS} = ();
open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
while (<MANI>) {
if (m!^pod/([^.]+\.pod)\s+!i) {
push @MANIPODS, $1;
}
}
close(MANI);
@MANIPODS{@MANIPODS} = ();
open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
while (<PERLPOD>) {
if (/^For ease of access, /../^\(If you're intending /) {
if (/^\s+(perl\S*)\s+\w/) {
push @PERLPODS, "$1.pod";
}
}
}
close(PERLPOD);
die "$0: could not find the pod listing of perl.pod\n"
unless @PERLPODS;
@PERLPODS{@PERLPODS} = ();
# Cross-check against ourselves
# Cross-check against the MANIFEST
# Cross-check against the perl.pod
foreach my $i (sort keys %PODS) {
warn "$0: $i exists but is unknown by buildtoc\n"
unless exists $pods{$i};
warn "$0: $i exists but is unknown by ../MANIFEST\n"
if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
warn "$0: $i exists but is unknown by perl.pod\n"
unless exists $PERLPODS{$i};
}
foreach my $i (sort keys %pods) {
warn "$0: $i is known by buildtoc but does not exist\n"
unless exists $PODS{$i};
}
foreach my $i (sort keys %MANIPODS) {
warn "$0: $i is known by ../MANIFEST but does not exist\n"
unless exists $PODS{$i};
}
foreach my $i (sort keys %PERLPODS) {
warn "$0: $i is known by perl.pod but does not exist\n"
unless exists $PODS{$i};
}
# We are ready to rock.
open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
$/ = '';
@ARGV = @pods;
($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
=head1 NAME
perltoc - perl documentation table of contents
=head1 DESCRIPTION
This page provides a brief table of contents for the rest of the Perl
documentation set. It is meant to be scanned quickly or grepped
through to locate the proper section you're looking for.
=head1 BASIC DOCUMENTATION
EOPOD2B
#' make emacs happy
podset(@pods);
find \&getpods => qw(../lib ../ext);
sub getpods {
if (/\.p(od|m)$/) {
# Skip .pm files that have corresponding .pod files, and Functions.pm.
return if /(.*)\.pm$/ && -f "$1.pod";
my $file = $File::Find::name;
return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
die "tut $name" if $file =~ /TUT/;
unless (open (F, "< $_\0")) {
warn "bogus <$file>: $!";
system "ls", "-l", $file;
}
else {
my $line;
while ($line = <F>) {
if ($line =~ /^=head1\s+NAME\b/) {
push @modpods, $file;
#warn "GOOD $file\n";
return;
}
}
warn "$0: $file: cannot find =head1 NAME\n";
}
}
}
die "no pods" unless @modpods;
for (@modpods) {
#($name) = /(\w+)\.p(m|od)$/;
$name = path2modname($_);
if ($name =~ /^[a-z]/) {
push @pragmata, $_;
} else {
if ($done{$name}++) {
# warn "already did $_\n";
next;
}
push @modules, $_;
push @modname, $name;
}
}
($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
=head1 PRAGMA DOCUMENTATION
EOPOD2B
podset(sort @pragmata);
($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
=head1 MODULE DOCUMENTATION
EOPOD2B
podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
($_= <<EOPOD2B) =~ s/^\t//gm;
=head1 AUXILIARY DOCUMENTATION
Here should be listed all the extra programs' documentation, but they
don't all have manual pages yet:
=over
=item a2p
=item s2p
=item find2perl
=item h2ph
=item c2ph
=item h2xs
=item xsubpp
=item pod2man
=item wrapsuid
=back
=head1 AUTHOR
Larry Wall <F<larry\@wall.org>>, with the help of oodles
of other folks.
EOPOD2B
output $_;
output "\n"; # flush $LINE
exit;
sub podset {
local @ARGV = @_;
while(<>) {
if (s/^=head1 (NAME)\s*/=head2 /) {
$pod = path2modname($ARGV);
unhead1();
output "\n \n\n=head2 ";
$_ = <>;
if ( /^\s*$pod\b/ ) {
s/$pod\.pm/$pod/; # '.pm' in NAME !?
output $_;
} else {
s/^/$pod, /;
output $_;
}
next;
}
if (s/^=head1 (.*)/=item $1/) {
unhead2();
output "=over\n\n" unless $inhead1;
$inhead1 = 1;
output $_; nl(); next;
}
if (s/^=head2 (.*)/=item $1/) {
unitem();
output "=over\n\n" unless $inhead2;
$inhead2 = 1;
output $_; nl(); next;
}
if (s/^=item ([^=].*)/$1/) {
next if $pod eq 'perldiag';
s/^\s*\*\s*$// && next;
s/^\s*\*\s*//;
s/\n/ /g;
s/\s+$//;
next if /^[\d.]+$/;
next if $pod eq 'perlmodlib' && /^ftp:/;
##print "=over\n\n" unless $initem;
output ", " if $initem;
$initem = 1;
s/\.$//;
s/^-X\b/-I<X>/;
output $_; next;
}
if (s/^=cut\s*\n//) {
unhead1();
next;
}
}
}
sub path2modname {
local $_ = shift;
s/\.p(m|od)$//;
s-.*?/(lib|ext)/--;
s-/-::-g;
s/(\w+)::\1/$1/;
return $_;
}
sub unhead1 {
unhead2();
if ($inhead1) {
output "\n\n=back\n\n";
}
$inhead1 = 0;
}
sub unhead2 {
unitem();
if ($inhead2) {
output "\n\n=back\n\n";
}
$inhead2 = 0;
}
sub unitem {
if ($initem) {
output "\n\n";
##print "\n\n=back\n\n";
}
$initem = 0;
}
sub nl {
output "\n";
}
my $NEWLINE; # how many newlines have we seen recently
my $LINE; # what remains to be printed
sub output ($) {
for (split /(\n)/, shift) {
if ($_ eq "\n") {
if ($LINE) {
print OUT wrap('', '', $LINE);
$LINE = '';
}
if ($NEWLINE < 2) {
print OUT;
$NEWLINE++;
}
}
elsif (/\S/ && length) {
$LINE .= $_;
$NEWLINE = 0;
}
}
}
!NO!SUBS!
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
chdir $origdir;