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.
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 sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
532 sub generate_manifest_readme {
533 generate_manifest sort {$a->[0] cmp $b->[0]}
534 ["README.vms", "Notes about installing the VMS port"],
535 map {["README.$_", $Readmes{$_}]} keys %Readmes;
538 sub generate_roffitall {
539 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
541 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
543 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
545 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
549 sub generate_descrip_mms_1 {
550 local $Text::Wrap::columns = 150;
552 my @lines = map {"pod" . $count++ . " = $_"}
553 split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
554 sort keys %Pods, keys %Readmepods);
555 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
558 sub generate_descrip_mms_2 {
560 [.lib.pods]$_.pod : [.pod]$_.pod
561 \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
562 Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
564 sort keys %Pods, keys %Readmepods;
567 sub generate_descrip_mms_3 {
568 map qq{\t- If F\$Search("[.pod]$_").nes."" Then Delete/NoConfirm/Log [.pod]$_;*},
569 sort keys %Generated, keys %Copies;
572 sub generate_nmake_1 {
573 # XXX Fix this with File::Spec
574 (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
576 (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
579 # This doesn't have a trailing newline
580 sub generate_nmake_2 {
581 # Spot the special case
582 local $Text::Wrap::columns = 76;
583 my $line = wrap ("\t ", "\t ",
584 join " ", sort keys %Copies, keys %Generated,
585 map {"perl$_.pod"} keys %Readmes);
590 sub generate_pod_mak {
591 my $variable = shift;
593 my $line = join "\\\n", "\U$variable = ",
594 map {"\t$_.$variable\t"} sort keys %Pods;
596 $line =~ s/.*perltoc.html.*\n//m;
600 sub verify_contiguous {
601 my ($name, $content, $what) = @_;
602 my $sections = () = $content =~ m/\0+/g;
603 croak("$0: $name contains no $what") if $sections < 1;
604 croak("$0: $name contains discontiguous $what") if $sections > 1;
610 grep {! m!^pod/[^.]+\.pod.*\n!}
611 grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
612 # Dictionary order - fold and handle non-word chars as nothing
614 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
615 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
617 &generate_manifest_pod(),
618 &generate_manifest_readme();
623 my $makefile = join '', @_;
624 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
625 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
626 verify_contiguous($name, $makefile, 'README copies');
627 # Now remove the other copies that follow
628 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
629 $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
631 $makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
632 {"$1\n" . &generate_nmake_2."\n\t $2"}se;
636 # shut up used only once warning
637 *do_dmake = *do_dmake = \&do_nmake;
641 my $pod = join '', @_;
643 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
644 (?:\s+[a-z]{4,}.*\n # fooo
645 |=head.*\n # =head foo
649 {$1 . join "", &generate_perlpod}mxe) {
650 die "$0: Failed to insert amendments in do_perlpod";
657 my $body = join '', @_;
658 foreach my $variable (qw(pod man html tex)) {
659 die "$0: could not find $variable in $name"
660 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
661 {"\n" . generate_pod_mak ($variable)}se;
668 my $makefile = join '', @_;
669 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
670 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
671 verify_contiguous($name, $makefile, 'pod assignments');
672 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
674 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
676 # Looking for rules like this
677 # [.lib.pods]perl.pod : [.pod]perl.pod
678 # @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
679 # Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
681 $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
682 [^\n]+\n # Another line
683 [^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods]
685 verify_contiguous($name, $makefile, 'copy rules');
686 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
688 # Looking for rules like this:
689 # - If F$Search("[.pod]perldelta.pod").nes."" Then Delete/NoConfirm/Log [.pod]perldelta.pod;*
690 $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;
691 verify_contiguous($name, $makefile, 'delete rules');
692 $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/se;
699 my $makefile_SH = join '', @_;
700 die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
702 $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
703 {join ' ', $1, map "pod/$_",
704 sort keys %Copies, grep {!/perltoc/} keys %Generated
707 # pod/perldelta.pod: pod/perl511delta.pod
708 # cd pod && $(LNS) perl511delta.pod perldelta.pod
711 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
712 \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
715 verify_contiguous($name, $makefile_SH, 'copy rules');
717 my @copy_rules = map "
718 pod/$_: pod/$Copies{$_}
719 \$(LNS) $Copies{$_} pod/$_
722 $makefile_SH =~ s/\0+/join '', @copy_rules/se;
730 while (my ($target, $name) = each %Targets) {
731 next unless $Build{$target};
733 if ($target eq "toc") {
734 print "Now processing $name\n" if $Verbose;
736 print "Finished\n" if $Verbose;
739 print "Now processing $name\n" if $Verbose;
740 open THING, $name or die "Can't open $name: $!";
742 my $orig = join '', @orig;
746 &{"do_$target"}($target, @orig);
748 my $new = join '', @new;
750 print "Was not modified\n" if $Verbose;
753 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
754 open THING, ">$name" or die "$0: Can't open $name for writing: $!";
755 print THING $new or die "$0: print to $name failed: $!";
756 close THING or die die "$0: close $name failed: $!";
759 warn "$0: was not instructed to build anything\n" unless $built;