diff options
Diffstat (limited to 'pod/buildtoc.PL')
| -rw-r--r-- | pod/buildtoc.PL | 467 |
1 files changed, 467 insertions, 0 deletions
diff --git a/pod/buildtoc.PL b/pod/buildtoc.PL new file mode 100644 index 0000000000..8e07ce856a --- /dev/null +++ b/pod/buildtoc.PL @@ -0,0 +1,467 @@ +#!/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 + perlreftut + perldsc + perllol + perlrequick + perlretut + + perllexwarn + perldebug + + perlrun + perlfunc + perlopentut + perlvar + perlsub + perlmod + perlpod + + perlstyle + perlmodlib + perlmodinstall + perlnewmod + perltrap + perlport + perlsec + + perlref + perlre + perlform + perllocale + perlunicode + + perlboot + perltoot + perltootc + perlobj + perlbot + perltie + + perlipc + perlnumber + perlfork + perlthrtut + + perldiag + 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 + perlvms + perlwin32 + ); + +@ARCHPODS = qw( + perlamiga + perlcygwin + perldos + perlhpux + perlmachten + perlos2 + perlos390 + 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\w*)\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! + |