4 use vars qw($masterpodfile %Build %Targets $Verbose $Quiet $Up %Ignore
5 @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
17 $Up = File::Spec->updir;
18 $masterpodfile = File::Spec->catdir($Up, "pod.lst");
20 # Generate any/all of these files
21 # --verbose gives slightly more output
22 # --quiet suppresses routine warnings
23 # --build-all tries to build everything
24 # --build-foo updates foo as follows
25 # --showfiles shows the files to be changed
30 manifest => File::Spec->catdir($Up, "MANIFEST"),
31 perlpod => "perl.pod",
32 vms => File::Spec->catdir($Up, "vms", "descrip_mms.template"),
33 nmake => File::Spec->catdir($Up, "win32", "Makefile"),
34 dmake => File::Spec->catdir($Up, "win32", "makefile.mk"),
35 podmak => File::Spec->catdir($Up, "win32", "pod.mak"),
36 # plan9 => File::Spec->catdir($Up, "plan9", "mkfile"),
37 unix => File::Spec->catdir($Up, "Makefile.SH"),
42 my @files = keys %Targets;
43 my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
46 $0: Usage: $0 [--verbose] [--showfiles] $filesopts
49 && GetOptions (verbose => \$Verbose,
51 showfiles => \$showfiles,
52 map {+"build-$_", \$Build{$_}} @files, 'all');
53 # Set them all to true
54 @Build{@files} = @files if ($Build{all});
58 sort { lc $a cmp lc $b }
60 my ($v, $d, $f) = File::Spec->splitpath($_);
62 @d = defined $d ? File::Spec->splitdir($d) : ();
64 File::Spec->catfile(@d ?
65 (@d == 1 && $d[0] eq '' ? () : @d)
67 } @Targets{grep { $_ ne 'all' && $Build{$_} } keys %Build}),
73 # Don't copy these top level READMEs
81 print "I'm building $_\n" foreach grep {$Build{$_}} keys %Build;
84 chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";
86 open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!";
88 my ($delta_source, $delta_target);
93 # At least one upper case letter somewhere in the first group
94 if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
98 my %flags = (header => 1);
99 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
100 $flags{aux} = 1 if $flags =~ tr/a//d;
101 die "$0: Unknown flag found in heading line: $_" if length $flags;
102 push @Master, [\%flags, $2];
104 } elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
106 my ($flags, $filename, $desc) = ($1, $2, $3);
108 my %flags = (indent => 0);
109 $flags{indent} = $1 if $flags =~ s/(\d+)//;
110 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
111 $flags{aux} = 1 if $flags =~ tr/a//d;
113 if ($flags =~ tr/D//d) {
114 $flags{perlpod_omit} = 1;
115 $delta_source = "$filename.pod";
117 if ($flags =~ tr/d//d) {
118 $flags{manifest_omit} = 1;
119 $delta_target = "$filename.pod";
121 $Generated{"$filename.pod"}++ if $flags =~ tr/g//d;
123 if ($flags =~ tr/r//d) {
124 my $readme = $filename;
125 $readme =~ s/^perl//;
126 $Readmepods{$filename} = $Readmes{$readme} = $desc;
128 } elsif ($flags{aux}) {
129 $Aux{$filename} = $desc;
131 $Pods{$filename} = $desc;
133 die "$0: Unknown flag found in section line: $_" if length $flags;
134 push @Master, [\%flags, $filename, $desc];
138 die "$0: Malformed line: $_" if $1 =~ tr/A-Z//;
141 if (defined $delta_source) {
142 if (defined $delta_target) {
143 # This way round so that keys can act as a MANIFEST skip list
144 # Targets will aways be in the pod directory. Currently we can only cope
145 # with sources being in the same directory. Fix this and do perlvms.pod
147 $Copies{$delta_target} = $delta_source;
149 die "$0: delta source defined but not target";
151 } elsif (defined $delta_target) {
152 die "$0: delta target defined but not target";
159 my (%disk_pods, @disk_pods);
160 my (@manipods, %manipods);
161 my (@manireadmes, %manireadmes);
162 my (@perlpods, %perlpods);
166 # Convert these to a list of filenames.
167 foreach (keys %Pods, keys %Readmepods) {
168 $our_pods{"$_.pod"}++;
171 # None of these filenames will be boolean false
172 @disk_pods = glob("*.pod");
173 @disk_pods{@disk_pods} = @disk_pods;
175 # Things we copy from won't be in perl.pod
176 # Things we copy to won't be in MANIFEST
177 @sources{values %Copies} = ();
179 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
181 if (m!^pod/([^.]+\.pod)\s+!i) {
183 } elsif (m!^README\.(\S+)\s+!i) {
185 push @manireadmes, "perl$1.pod";
189 @manipods{@manipods} = @manipods;
190 @manireadmes{@manireadmes} = @manireadmes;
192 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
194 if (/^For ease of access, /../^\(If you're intending /) {
195 if (/^\s+(perl\S*)\s+\w/) {
196 push @perlpods, "$1.pod";
201 die "$0: could not find the pod listing of perl.pod\n"
203 @perlpods{@perlpods} = @perlpods;
205 foreach my $i (sort keys %disk_pods) {
206 warn "$0: $i exists but is unknown by buildtoc\n"
207 unless $our_pods{$i};
208 warn "$0: $i exists but is unknown by ../MANIFEST\n"
209 if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i};
210 warn "$0: $i exists but is unknown by perl.pod\n"
211 if !$perlpods{$i} && !exists $sources{$i};
213 foreach my $i (sort keys %our_pods) {
214 warn "$0: $i is known by buildtoc but does not exist\n"
215 unless $disk_pods{$i};
217 foreach my $i (sort keys %manipods) {
218 warn "$0: $i is known by ../MANIFEST but does not exist\n"
219 unless $disk_pods{$i};
220 warn "$0: $i is known by ../MANIFEST but is marked as generated\n"
223 foreach my $i (sort keys %perlpods) {
224 warn "$0: $i is known by perl.pod but does not exist\n"
225 unless $disk_pods{$i};
229 # Find all the mdoules
232 find \&getpods => qw(../lib ../ext);
236 my $file = $File::Find::name;
237 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
238 return if $file =~ m!(?:^|/)t/!;
239 return if $file =~ m!lib/Attribute/Handlers/demo/!;
240 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
241 return if $file =~ m!lib/Math/BigInt/t/!;
242 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
243 return if $file =~ m!XS/(?:APItest|Typemap)!;
245 return if $pod =~ s/pm$/pod/ && -e $pod;
246 die "$0: tut $File::Find::name" if $file =~ /TUT/;
247 unless (open (F, "< $_\0")) {
248 warn "$0: bogus <$file>: $!";
249 system "ls", "-l", $file;
253 while ($line = <F>) {
254 if ($line =~ /^=head1\s+NAME\b/) {
255 push @modpods, $file;
256 #warn "GOOD $file\n";
260 warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet;
265 die "$0: no pods" unless @modpods;
269 #($name) = /(\w+)\.p(m|od)$/;
270 my $name = path2modname($_);
271 if ($name =~ /^[a-z]/) {
272 $Pragmata{$name} = $_;
274 if ($done{$name}++) {
275 # warn "already did $_\n";
278 $Modules{$name} = $_;
283 # OK. Now a lot of ancillary function definitions follow
284 # Main program returns at "Do stuff"
298 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
302 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
304 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
305 # This file is autogenerated by buildtoc from all the other pods.
306 # Edit those files and run buildtoc --build-toc to effect changes.
310 perltoc - perl documentation table of contents
314 This page provides a brief table of contents for the rest of the Perl
315 documentation set. It is meant to be scanned quickly or grepped
316 through to locate the proper section you're looking for.
318 =head1 BASIC DOCUMENTATION
323 # All the things in the master list that happen to be pod filenames
324 podset(map {"$_->[1].pod"} grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master);
327 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
331 =head1 PRAGMA DOCUMENTATION
335 podset(sort values %Pragmata);
337 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
341 =head1 MODULE DOCUMENTATION
345 podset( @Modules{ sort keys %Modules } );
350 =head1 AUXILIARY DOCUMENTATION
352 Here should be listed all the extra programs' documentation, but they
353 don't all have manual pages yet:
359 $_ .= join "\n", map {"\t=item $_\n"} sort keys %Aux;
366 Larry Wall <F<larry\@wall.org>>, with the help of oodles
374 output "\n"; # flush $LINE
377 # Below are all the auxiliary routines for generating perltoc.pod
379 my ($inhead1, $inhead2, $initem);
387 if (s/^=head1 (NAME)\s*/=head2 /) {
388 $pod = path2modname($ARGV);
390 output "\n \n\n=head2 ";
392 # Remove svn keyword expansions from the Perl FAQ
393 s/ \(\$Revision: \d+ \$\)//g;
394 if ( /^\s*$pod\b/ ) {
395 s/$pod\.pm/$pod/; # '.pm' in NAME !?
403 if (s/^=head1 (.*)/=item $1/) {
405 output "=over 4\n\n" unless $inhead1;
407 output $_; nl(); next;
409 if (s/^=head2 (.*)/=item $1/) {
411 output "=over 4\n\n" unless $inhead2;
413 output $_; nl(); next;
415 if (s/^=item ([^=].*)/$1/) {
416 next if $pod eq 'perldiag';
417 s/^\s*\*\s*$// && next;
422 next if $pod eq 'perlmodlib' && /^ftp:/;
423 ##print "=over 4\n\n" unless $initem;
424 output ", " if $initem;
430 if (s/^=cut\s*\n//) {
440 output "\n\n=back\n\n";
448 output "\n\n=back\n\n";
456 ##print "\n\n=back\n\n";
465 my $NEWLINE = 0; # how many newlines have we seen recently
466 my $LINE; # what remains to be printed
469 for (split /(\n)/, shift) {
472 print OUT wrap('', '', $LINE);
475 if (($NEWLINE) < 2) {
480 elsif (/\S/ && length) {
487 # End of original buildtoc. From here on are routines to generate new sections
488 # for and inplace edit other files
490 sub generate_perlpod {
495 next if $flags->{aux};
496 next if $flags->{perlpod_omit};
500 push @output, "=head2 $_->[1]\n";
503 my $start = " " x (4 + $flags->{indent}) . $_->[1];
504 $maxlength = length $start if length ($start) > $maxlength;
505 push @output, [$start, $_->[2]];
510 die "$0: Illegal length " . scalar @$_;
513 # want at least 2 spaces padding
515 $maxlength = ($maxlength + 3) & ~3;
516 # sprintf gives $1.....$2 where ... are spaces:
517 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
522 sub generate_manifest {
523 # Annyoingly unexpand doesn't consider it good form to replace a single
524 # space before a tab with a tab
525 # Annoyingly (2) it returns read only values.
526 my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
527 map {s/ \t/\t\t/g; $_} @temp;
529 sub generate_manifest_pod {
530 generate_manifest map {["pod/$_.pod", $Pods{$_}]}
531 sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
533 sub generate_manifest_readme {
534 generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
537 sub generate_roffitall {
538 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
540 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
542 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
544 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
548 sub generate_descrip_mms_1 {
549 local $Text::Wrap::columns = 150;
551 my @lines = map {"pod" . $count++ . " = $_"}
552 split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
553 sort keys %Pods, keys %Readmepods);
554 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
557 sub generate_descrip_mms_2 {
558 map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
559 [.lib.pods]%s.pod : [.%s]%s.pod
560 @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
561 Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
563 sort keys %Pods, keys %Readmepods;
566 sub generate_descrip_mms_3 {
567 map qq{\t- If F\$Search("[.pod]$_").nes."" Then Delete/NoConfirm/Log [.pod]$_;*},
568 sort keys %Generated, keys %Copies;
571 sub generate_nmake_1 {
572 # XXX Fix this with File::Spec
573 (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
575 (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
578 # This doesn't have a trailing newline
579 sub generate_nmake_2 {
580 # Spot the special case
581 local $Text::Wrap::columns = 76;
582 my $line = wrap ("\t ", "\t ",
583 join " ", sort keys %Copies, keys %Generated,
584 map {"perl$_.pod"} "vms", keys %Readmes);
589 sub generate_pod_mak {
590 my $variable = shift;
592 my $line = join "\\\n", "\U$variable = ",
593 map {"\t$_.$variable\t"} sort keys %Pods;
595 $line =~ s/.*perltoc.html.*\n//m;
599 sub verify_contiguous {
600 my ($name, $content, $what) = @_;
601 my $sections = () = $content =~ m/\0+/g;
602 croak("$0: $name contains no $what") if $sections < 1;
603 croak("$0: $name contains discontiguous $what") if $sections > 1;
609 grep {! m!^pod/[^.]+\.pod.*\n!}
610 grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
611 # Dictionary order - fold and handle non-word chars as nothing
613 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
614 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
616 &generate_manifest_pod(),
617 &generate_manifest_readme();
622 my $makefile = join '', @_;
623 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
624 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
625 verify_contiguous($name, $makefile, 'README copies');
626 # Now remove the other copies that follow
627 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
628 $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
630 $makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
631 {"$1\n" . &generate_nmake_2."\n\t $2"}se;
635 # shut up used only once warning
636 *do_dmake = *do_dmake = \&do_nmake;
640 my $pod = join '', @_;
642 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
643 (?:\s+[a-z]{4,}.*\n # fooo
644 |=head.*\n # =head foo
648 {$1 . join "", &generate_perlpod}mxe) {
649 die "$0: Failed to insert amendments in do_perlpod";
656 my $body = join '', @_;
657 foreach my $variable (qw(pod man html tex)) {
658 die "$0: could not find $variable in $name"
659 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
660 {"\n" . generate_pod_mak ($variable)}se;
667 my $makefile = join '', @_;
668 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
669 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
670 verify_contiguous($name, $makefile, 'pod assignments');
671 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
673 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
675 # Looking for rules like this
676 # [.lib.pods]perl.pod : [.pod]perl.pod
677 # @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
678 # Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
680 $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
681 [^\n]+\n # Another line
682 [^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods]
684 verify_contiguous($name, $makefile, 'copy rules');
685 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
687 # Looking for rules like this:
688 # - If F$Search("[.pod]perldelta.pod").nes."" Then Delete/NoConfirm/Log [.pod]perldelta.pod;*
689 $makefile =~ s!(?:\t- If F\$Search\("\[\.pod\]perl[a-z]+\Q.pod").nes."" Then Delete/NoConfirm/Log [.pod]perl\E[a-z]+\.pod;\*\n)+!\0!sg;
690 verify_contiguous($name, $makefile, 'delete rules');
691 $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/se;
698 my $makefile_SH = join '', @_;
699 die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
701 $makefile_SH =~ s/\n\s+-\@test -f \S+ && cd pod && \$\(LNS\) \S+ \S+ && cd \.\. && echo "\S+" >> extra.pods \# See buildtoc\n/\0/gm;
703 verify_contiguous($name, $makefile_SH, 'copy rules');
705 my @copy_rules = map "\t-\@test -f pod/$Copies{$_} && cd pod && \$(LNS) $Copies{$_} $_ && cd .. && echo \"pod/$_\" >> extra.pods # See buildtoc",
708 $makefile_SH =~ s/\0+/join "\n", '', @copy_rules, ''/se;
716 while (my ($target, $name) = each %Targets) {
717 next unless $Build{$target};
719 if ($target eq "toc") {
720 print "Now processing $name\n" if $Verbose;
722 print "Finished\n" if $Verbose;
725 print "Now processing $name\n" if $Verbose;
726 open THING, $name or die "Can't open $name: $!";
728 my $orig = join '', @orig;
732 &{"do_$target"}($target, @orig);
734 my $new = join '', @new;
736 print "Was not modified\n" if $Verbose;
739 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
740 open THING, ">$name" or die "$0: Can't open $name for writing: $!";
741 print THING $new or die "$0: print to $name failed: $!";
742 close THING or die die "$0: close $name failed: $!";
745 warn "$0: was not instructed to build anything\n" unless $built;