4 use vars qw($masterpodfile %Build %Targets $Verbose $Quiet $Up %Ignore
5 @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
16 $Up = File::Spec->updir;
17 $masterpodfile = File::Spec->catdir($Up, "pod.lst");
19 # Generate any/all of these files
20 # --verbose gives slightly more output
21 # --quiet suppresses routine warnings
22 # --build-all tries to build everything
23 # --build-foo updates foo as follows
24 # --showfiles shows the files to be changed
29 manifest => File::Spec->catdir($Up, "MANIFEST"),
30 perlpod => "perl.pod",
31 vms => File::Spec->catdir($Up, "vms", "descrip_mms.template"),
32 nmake => File::Spec->catdir($Up, "win32", "Makefile"),
33 dmake => File::Spec->catdir($Up, "win32", "makefile.mk"),
34 podmak => File::Spec->catdir($Up, "win32", "pod.mak"),
35 # plan9 => File::Spec->catdir($Up, "plan9", "mkfile"),
36 unix => File::Spec->catdir($Up, "Makefile.SH"),
41 my @files = keys %Targets;
42 my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
45 $0: Usage: $0 [--verbose] [--showfiles] $filesopts
48 && GetOptions (verbose => \$Verbose,
50 showfiles => \$showfiles,
51 map {+"build-$_", \$Build{$_}} @files, 'all');
52 # Set them all to true
53 @Build{@files} = @files if ($Build{all});
57 sort { lc $a cmp lc $b }
59 my ($v, $d, $f) = File::Spec->splitpath($_);
61 @d = defined $d ? File::Spec->splitdir($d) : ();
63 File::Spec->catfile(@d ?
64 (@d == 1 && $d[0] eq '' ? () : @d)
66 } @Targets{grep { $_ ne 'all' && $Build{$_} } keys %Build}),
72 # Don't copy these top level READMEs
80 print "I'm building $_\n" foreach grep {$Build{$_}} keys %Build;
83 chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";
85 open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!";
87 my ($delta_source, $delta_target);
92 # At least one upper case letter somewhere in the first group
93 if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
97 my %flags = (header => 1);
98 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
99 $flags{aux} = 1 if $flags =~ tr/a//d;
100 die "$0: Unknown flag found in heading line: $_" if length $flags;
101 push @Master, [\%flags, $2];
103 } elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
105 my ($flags, $filename, $desc) = ($1, $2, $3);
107 my %flags = (indent => 0);
108 $flags{indent} = $1 if $flags =~ s/(\d+)//;
109 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
110 $flags{aux} = 1 if $flags =~ tr/a//d;
112 if ($flags =~ tr/D//d) {
113 $flags{perlpod_omit} = 1;
114 $delta_source = "$filename.pod";
116 if ($flags =~ tr/d//d) {
117 $flags{manifest_omit} = 1;
118 $delta_target = "$filename.pod";
120 $Generated{"$filename.pod"}++ if $flags =~ tr/g//d;
122 if ($flags =~ tr/r//d) {
123 my $readme = $filename;
124 $readme =~ s/^perl//;
125 $Readmepods{$filename} = $Readmes{$readme} = $desc;
127 } elsif ($flags{aux}) {
128 $Aux{$filename} = $desc;
130 $Pods{$filename} = $desc;
132 die "$0: Unknown flag found in section line: $_" if length $flags;
133 push @Master, [\%flags, $filename, $desc];
137 die "$0: Malformed line: $_" if $1 =~ tr/A-Z//;
140 if (defined $delta_source) {
141 if (defined $delta_target) {
142 # This way round so that keys can act as a MANIFEST skip list
143 # Targets will aways be in the pod directory. Currently we can only cope
144 # with sources being in the same directory. Fix this and do perlvms.pod
146 $Copies{$delta_target} = $delta_source;
148 die "$0: delta source defined but not target";
150 } elsif (defined $delta_target) {
151 die "$0: delta target defined but not target";
158 my (%disk_pods, @disk_pods);
159 my (@manipods, %manipods);
160 my (@manireadmes, %manireadmes);
161 my (@perlpods, %perlpods);
165 # Convert these to a list of filenames.
166 foreach (keys %Pods, keys %Readmepods) {
167 $our_pods{"$_.pod"}++;
170 # None of these filenames will be boolean false
171 @disk_pods = glob("*.pod");
172 @disk_pods{@disk_pods} = @disk_pods;
174 # Things we copy from won't be in perl.pod
175 # Things we copy to won't be in MANIFEST
176 @sources{values %Copies} = ();
178 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
180 if (m!^pod/([^.]+\.pod)\s+!i) {
182 } elsif (m!^README\.(\S+)\s+!i) {
184 push @manireadmes, "perl$1.pod";
188 @manipods{@manipods} = @manipods;
189 @manireadmes{@manireadmes} = @manireadmes;
191 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
193 if (/^For ease of access, /../^\(If you're intending /) {
194 if (/^\s+(perl\S*)\s+\w/) {
195 push @perlpods, "$1.pod";
200 die "$0: could not find the pod listing of perl.pod\n"
202 @perlpods{@perlpods} = @perlpods;
204 foreach my $i (sort keys %disk_pods) {
205 warn "$0: $i exists but is unknown by buildtoc\n"
206 unless $our_pods{$i};
207 warn "$0: $i exists but is unknown by ../MANIFEST\n"
208 if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i};
209 warn "$0: $i exists but is unknown by perl.pod\n"
210 if !$perlpods{$i} && !exists $sources{$i};
212 foreach my $i (sort keys %our_pods) {
213 warn "$0: $i is known by buildtoc but does not exist\n"
214 unless $disk_pods{$i};
216 foreach my $i (sort keys %manipods) {
217 warn "$0: $i is known by ../MANIFEST but does not exist\n"
218 unless $disk_pods{$i};
219 warn "$0: $i is known by ../MANIFEST but is marked as generated\n"
222 foreach my $i (sort keys %perlpods) {
223 warn "$0: $i is known by perl.pod but does not exist\n"
224 unless $disk_pods{$i};
228 # Find all the mdoules
231 find \&getpods => qw(../lib ../ext);
235 my $file = $File::Find::name;
236 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
237 return if $file =~ m!(?:^|/)t/!;
238 return if $file =~ m!lib/Attribute/Handlers/demo/!;
239 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
240 return if $file =~ m!lib/Math/BigInt/t/!;
241 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
242 return if $file =~ m!XS/(?:APItest|Typemap)!;
244 return if $pod =~ s/pm$/pod/ && -e $pod;
245 die "$0: tut $File::Find::name" if $file =~ /TUT/;
246 unless (open (F, "< $_\0")) {
247 warn "$0: bogus <$file>: $!";
248 system "ls", "-l", $file;
252 while ($line = <F>) {
253 if ($line =~ /^=head1\s+NAME\b/) {
254 push @modpods, $file;
255 #warn "GOOD $file\n";
259 warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet;
264 die "$0: no pods" unless @modpods;
268 #($name) = /(\w+)\.p(m|od)$/;
269 my $name = path2modname($_);
270 if ($name =~ /^[a-z]/) {
271 $Pragmata{$name} = $_;
273 if ($done{$name}++) {
274 # warn "already did $_\n";
277 $Modules{$name} = $_;
282 # OK. Now a lot of ancillary function definitions follow
283 # Main program returns at "Do stuff"
297 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
301 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
303 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
304 # This file is autogenerated by buildtoc from all the other pods.
305 # Edit those files and run buildtoc --build-toc to effect changes.
309 perltoc - perl documentation table of contents
313 This page provides a brief table of contents for the rest of the Perl
314 documentation set. It is meant to be scanned quickly or grepped
315 through to locate the proper section you're looking for.
317 =head1 BASIC DOCUMENTATION
322 # All the things in the master list that happen to be pod filenames
323 podset(map {"$_->[1].pod"} grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master);
326 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
330 =head1 PRAGMA DOCUMENTATION
334 podset(sort values %Pragmata);
336 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
340 =head1 MODULE DOCUMENTATION
344 podset( @Modules{ sort keys %Modules } );
349 =head1 AUXILIARY DOCUMENTATION
351 Here should be listed all the extra programs' documentation, but they
352 don't all have manual pages yet:
358 $_ .= join "\n", map {"\t=item $_\n"} sort keys %Aux;
365 Larry Wall <F<larry\@wall.org>>, with the help of oodles
373 output "\n"; # flush $LINE
376 # Below are all the auxiliary routines for generating perltoc.pod
378 my ($inhead1, $inhead2, $initem);
386 if (s/^=head1 (NAME)\s*/=head2 /) {
387 $pod = path2modname($ARGV);
389 output "\n \n\n=head2 ";
391 # Remove svn keyword expansions from the Perl FAQ
392 s/ \(\$Revision: \d+ \$\)//g;
393 if ( /^\s*$pod\b/ ) {
394 s/$pod\.pm/$pod/; # '.pm' in NAME !?
402 if (s/^=head1 (.*)/=item $1/) {
404 output "=over 4\n\n" unless $inhead1;
406 output $_; nl(); next;
408 if (s/^=head2 (.*)/=item $1/) {
410 output "=over 4\n\n" unless $inhead2;
412 output $_; nl(); next;
414 if (s/^=item ([^=].*)/$1/) {
415 next if $pod eq 'perldiag';
416 s/^\s*\*\s*$// && next;
421 next if $pod eq 'perlmodlib' && /^ftp:/;
422 ##print "=over 4\n\n" unless $initem;
423 output ", " if $initem;
429 if (s/^=cut\s*\n//) {
439 output "\n\n=back\n\n";
447 output "\n\n=back\n\n";
455 ##print "\n\n=back\n\n";
464 my $NEWLINE = 0; # how many newlines have we seen recently
465 my $LINE; # what remains to be printed
468 for (split /(\n)/, shift) {
471 print OUT wrap('', '', $LINE);
474 if (($NEWLINE) < 2) {
479 elsif (/\S/ && length) {
486 # End of original buildtoc. From here on are routines to generate new sections
487 # for and inplace edit other files
489 sub generate_perlpod {
494 next if $flags->{aux};
495 next if $flags->{perlpod_omit};
499 push @output, "=head2 $_->[1]\n";
502 my $start = " " x (4 + $flags->{indent}) . $_->[1];
503 $maxlength = length $start if length ($start) > $maxlength;
504 push @output, [$start, $_->[2]];
509 die "$0: Illegal length " . scalar @$_;
512 # want at least 2 spaces padding
514 $maxlength = ($maxlength + 3) & ~3;
515 # sprintf gives $1.....$2 where ... are spaces:
516 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
521 sub generate_manifest {
522 # Annyoingly unexpand doesn't consider it good form to replace a single
523 # space before a tab with a tab
524 # Annoyingly (2) it returns read only values.
525 my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
526 map {s/ \t/\t\t/g; $_} @temp;
528 sub generate_manifest_pod {
529 generate_manifest map {["pod/$_.pod", $Pods{$_}]}
530 grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} sort keys %Pods;
532 sub generate_manifest_readme {
533 generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
536 sub generate_roffitall {
537 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
539 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
541 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
543 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
547 sub generate_descrip_mms_1 {
548 local $Text::Wrap::columns = 150;
550 my @lines = map {"pod" . $count++ . " = $_"}
551 split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
552 sort keys %Pods, keys %Readmepods);
553 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
556 sub generate_descrip_mms_2 {
557 map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
558 [.lib.pods]%s.pod : [.%s]%s.pod
559 @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
560 Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
562 sort keys %Pods, keys %Readmepods;
565 sub generate_nmake_1 {
566 # XXX Fix this with File::Spec
567 (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
569 (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
572 # This doesn't have a trailing newline
573 sub generate_nmake_2 {
574 # Spot the special case
575 local $Text::Wrap::columns = 76;
576 my $line = wrap ("\t ", "\t ",
577 join " ", sort keys %Copies,
578 map {"perl$_.pod"} "vms", keys %Readmes);
583 sub generate_pod_mak {
584 my $variable = shift;
586 my $line = join "\\\n", "\U$variable = ",
587 map {"\t$_.$variable\t"} sort keys %Pods;
589 $line =~ s/.*perltoc.html.*\n//m;
596 grep {! m!^pod/[^.]+\.pod.*\n!}
597 grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
598 # Dictionary order - fold and handle non-word chars as nothing
600 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
601 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
603 &generate_manifest_pod(),
604 &generate_manifest_readme();
609 my $makefile = join '', @_;
610 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
611 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
612 my $sections = () = $makefile =~ m/\0+/g;
613 die "$0: $name contains no README copies" if $sections < 1;
614 die "$0: $name contains discontiguous README copies" if $sections > 1;
615 # Now remove the other copies that follow
616 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
617 $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
619 $makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
620 {"$1\n" . &generate_nmake_2."\n\t $2"}se;
624 # shut up used only once warning
625 *do_dmake = *do_dmake = \&do_nmake;
629 my $pod = join '', @_;
631 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
632 (?:\s+[a-z]{4,}.*\n # fooo
633 |=head.*\n # =head foo
637 {$1 . join "", &generate_perlpod}mxe) {
638 die "$0: Failed to insert amendments in do_perlpod";
645 my $body = join '', @_;
646 foreach my $variable (qw(pod man html tex)) {
647 die "$0: could not find $variable in $name"
648 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
649 {"\n" . generate_pod_mak ($variable)}se;
656 my $makefile = join '', @_;
657 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
658 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
659 my $sections = () = $makefile =~ m/\0+/g;
660 die "$0: $name contains no pod assignments" if $sections < 1;
661 die "$0: $name contains $sections discontigous pod assignments"
663 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
665 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
667 # Looking for rules like this
668 # [.lib.pods]perl.pod : [.pod]perl.pod
669 # @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
670 # Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
672 $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
673 [^\n]+\n # Another line
674 [^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods]
676 $sections = () = $makefile =~ m/\0+/g;
677 die "$0: $name contains no copy rules" if $sections < 1;
678 die "$0: $name contains $sections discontigous copy rules"
680 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
686 my $makefile_SH = join '', @_;
687 die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
689 $makefile_SH =~ s/\n\s+-\@test -f \S+ && cd pod && \$\(LNS\) \S+ \S+ && cd \.\. && echo "\S+" >> extra.pods \# See buildtoc\n/\0/gm;
691 my $sections = () = $makefile_SH =~ m/\0+/g;
693 die "$0: $name contains no copy rules" if $sections < 1;
694 die "$0: $name contains $sections discontigous copy rules"
697 my @copy_rules = map "\t-\@test -f pod/$Copies{$_} && cd pod && \$(LNS) $Copies{$_} $_ && cd .. && echo \"pod/$_\" >> extra.pods # See buildtoc",
700 $makefile_SH =~ s/\0+/join "\n", '', @copy_rules, ''/se;
708 while (my ($target, $name) = each %Targets) {
709 next unless $Build{$target};
711 if ($target eq "toc") {
712 print "Now processing $name\n" if $Verbose;
714 print "Finished\n" if $Verbose;
717 print "Now processing $name\n" if $Verbose;
718 open THING, $name or die "Can't open $name: $!";
720 my $orig = join '', @orig;
724 &{"do_$target"}($target, @orig);
726 my $new = join '', @new;
728 print "Was not modified\n" if $Verbose;
731 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
732 open THING, ">$name" or die "$0: Can't open $name for writing: $!";
733 print THING $new or die "$0: print to $name failed: $!";
734 close THING or die die "$0: close $name failed: $!";
737 warn "$0: was not instructed to build anything\n" unless $built;