#!/usr/bin/perl eval 'exec perl -S $0 "$@"' if 0; # # 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 perlclib perlguts perlcall perlutil perlfilter perldbmfilter perlapi perlintern perlapio perltodo perlhack perlhist perldelta perl5005delta perl5004delta perlaix perlamiga perlbs2000 perlcygwin perldos perlepoc perlhpux perlmachten perlmacos perlmpeix perlos2 perlos390 perlsolaris perlvmesa perlvms perlvos perlwin32 ); @ARCHPODS = qw( perlaix perlamiga perlbs2000 perlcygwin perldos perlepoc perlhpux perlmachten perlmacos perlmpeix perlos2 perlos390 perlsolaris perlvmesa perlvms perlvos perlwin32 ); for (@ARCHPODS) { s/$/.pod/ } @ARCHPODS{@ARCHPODS} = (); for (@pods) { s/$/.pod/ } @pods{@pods} = (); @PODS{@PODS} = (); open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!"; while () { 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 () { 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; ($_= < 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 = ) { 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; } } ($_= <>, 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 4\n\n" unless $inhead1; $inhead1 = 1; output $_; nl(); next; } if (s/^=head2 (.*)/=item $1/) { unitem(); output "=over 4\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 4\n\n" unless $initem; output ", " if $initem; $initem = 1; s/\.$//; s/^-X\b/-I/; 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; } } }