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->catfile($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->catfile($Up, "vms", "descrip_mms.template"),
33 nmake => File::Spec->catfile($Up, "win32", "Makefile"),
34 dmake => File::Spec->catfile($Up, "win32", "makefile.mk"),
35 podmak => File::Spec->catfile($Up, "win32", "pod.mak"),
36 # plan9 => File::Spec->catdir($Up, "plan9", "mkfile"),
37 unix => File::Spec->catfile($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 modules
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";
261 warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet;
266 die "$0: no pods" unless @modpods;
270 #($name) = /(\w+)\.p(m|od)$/;
271 my $name = path2modname($_);
272 if ($name =~ /^[a-z]/) {
273 $Pragmata{$name} = $_;
275 if ($done{$name}++) {
276 # warn "already did $_\n";
279 $Modules{$name} = $_;
284 # OK. Now a lot of ancillary function definitions follow
285 # Main program returns at "Do stuff"
299 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
303 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
305 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
306 # This file is autogenerated by buildtoc from all the other pods.
307 # Edit those files and run buildtoc --build-toc to effect changes.
311 perltoc - perl documentation table of contents
315 This page provides a brief table of contents for the rest of the Perl
316 documentation set. It is meant to be scanned quickly or grepped
317 through to locate the proper section you're looking for.
319 =head1 BASIC DOCUMENTATION
324 # All the things in the master list that happen to be pod filenames
325 podset(map {"$_->[1].pod"} grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master);
328 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
332 =head1 PRAGMA DOCUMENTATION
336 podset(sort values %Pragmata);
338 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
342 =head1 MODULE DOCUMENTATION
346 podset( @Modules{ sort keys %Modules } );
351 =head1 AUXILIARY DOCUMENTATION
353 Here should be listed all the extra programs' documentation, but they
354 don't all have manual pages yet:
360 $_ .= join "\n", map {"\t=item $_\n"} sort keys %Aux;
367 Larry Wall <F<larry\@wall.org>>, with the help of oodles
375 output "\n"; # flush $LINE
379 # Below are all the auxiliary routines for generating perltoc.pod
381 my ($inhead1, $inhead2, $initem);
387 return unless scalar(@ARGV);
391 if (s/^=head1 (NAME)\s*/=head2 /) {
392 $pod = path2modname($ARGV);
394 output "\n \n\n=head2 ";
396 # Remove svn keyword expansions from the Perl FAQ
397 s/ \(\$Revision: \d+ \$\)//g;
398 if ( /^\s*$pod\b/ ) {
399 s/$pod\.pm/$pod/; # '.pm' in NAME !?
407 if (s/^=head1 (.*)/=item $1/) {
409 output "=over 4\n\n" unless $inhead1;
411 output $_; nl(); next;
413 if (s/^=head2 (.*)/=item $1/) {
415 output "=over 4\n\n" unless $inhead2;
417 output $_; nl(); next;
419 if (s/^=item ([^=].*)/$1/) {
420 next if $pod eq 'perldiag';
421 s/^\s*\*\s*$// && next;
426 next if $pod eq 'perlmodlib' && /^ftp:/;
427 ##print "=over 4\n\n" unless $initem;
428 output ", " if $initem;
434 if (s/^=cut\s*\n//) {
444 output "\n\n=back\n\n";
452 output "\n\n=back\n\n";
460 ##print "\n\n=back\n\n";
469 my $NEWLINE = 0; # how many newlines have we seen recently
470 my $LINE; # what remains to be printed
473 for (split /(\n)/, shift) {
476 print OUT wrap('', '', $LINE);
479 if (($NEWLINE) < 2) {
484 elsif (/\S/ && length) {
491 # End of original buildtoc. From here on are routines to generate new sections
492 # for and inplace edit other files
494 sub generate_perlpod {
499 next if $flags->{aux};
500 next if $flags->{perlpod_omit};
504 push @output, "=head2 $_->[1]\n";
507 my $start = " " x (4 + $flags->{indent}) . $_->[1];
508 $maxlength = length $start if length ($start) > $maxlength;
509 push @output, [$start, $_->[2]];
514 die "$0: Illegal length " . scalar @$_;
517 # want at least 2 spaces padding
519 $maxlength = ($maxlength + 3) & ~3;
520 # sprintf gives $1.....$2 where ... are spaces:
521 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
526 sub generate_manifest {
527 # Annyoingly unexpand doesn't consider it good form to replace a single
528 # space before a tab with a tab
529 # Annoyingly (2) it returns read only values.
530 my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
531 map {s/ \t/\t\t/g; $_} @temp;
533 sub generate_manifest_pod {
534 generate_manifest map {["pod/$_.pod", $Pods{$_}]}
535 sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
537 sub generate_manifest_readme {
538 generate_manifest sort {$a->[0] cmp $b->[0]}
539 ["README.vms", "Notes about installing the VMS port"],
540 map {["README.$_", $Readmes{$_}]} keys %Readmes;
543 sub generate_roffitall {
544 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
546 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
548 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
550 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
554 sub generate_descrip_mms_1 {
555 local $Text::Wrap::columns = 150;
557 my @lines = map {"pod" . $count++ . " = $_"}
558 split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
559 sort keys %Pods, keys %Readmepods);
560 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
563 sub generate_descrip_mms_2 {
565 [.lib.pods]$_.pod : [.pod]$_.pod
566 \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
567 Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
569 sort keys %Pods, keys %Readmepods;
572 sub generate_descrip_mms_3 {
573 map qq{\t- If F\$Search("[.pod]$_").nes."" Then Delete/NoConfirm/Log [.pod]$_;*},
574 sort keys %Generated, keys %Copies;
577 sub generate_nmake_1 {
578 # XXX Fix this with File::Spec
579 (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
581 (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
584 # This doesn't have a trailing newline
585 sub generate_nmake_2 {
586 # Spot the special case
587 local $Text::Wrap::columns = 76;
588 my $line = wrap ("\t ", "\t ",
589 join " ", sort keys %Copies, keys %Generated,
590 map {"perl$_.pod"} keys %Readmes);
595 sub generate_pod_mak {
596 my $variable = shift;
598 my $line = join "\\\n", "\U$variable = ",
599 map {"\t$_.$variable\t"} sort keys %Pods;
601 $line =~ s/.*perltoc.html.*\n//m;
605 sub verify_contiguous {
606 my ($name, $content, $what) = @_;
607 my $sections = () = $content =~ m/\0+/g;
608 croak("$0: $name contains no $what") if $sections < 1;
609 croak("$0: $name contains discontiguous $what") if $sections > 1;
615 grep {! m!^pod/[^.]+\.pod.*\n!}
616 grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
617 # Dictionary order - fold and handle non-word chars as nothing
619 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
620 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
622 &generate_manifest_pod(),
623 &generate_manifest_readme();
628 my $makefile = join '', @_;
629 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
630 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
631 verify_contiguous($name, $makefile, 'README copies');
632 # Now remove the other copies that follow
633 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
634 $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
636 $makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
637 {"$1\n" . &generate_nmake_2."\n\t $2"}se;
641 # shut up used only once warning
642 *do_dmake = *do_dmake = \&do_nmake;
646 my $pod = join '', @_;
648 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
649 (?:\s+[a-z]{4,}.*\n # fooo
650 |=head.*\n # =head foo
654 {$1 . join "", &generate_perlpod}mxe) {
655 die "$0: Failed to insert amendments in do_perlpod";
662 my $body = join '', @_;
663 foreach my $variable (qw(pod man html tex)) {
664 die "$0: could not find $variable in $name"
665 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
666 {"\n" . generate_pod_mak ($variable)}se;
673 my $makefile = join '', @_;
674 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
675 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
676 verify_contiguous($name, $makefile, 'pod assignments');
677 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
679 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
681 # Looking for rules like this
682 # [.lib.pods]perl.pod : [.pod]perl.pod
683 # @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
684 # Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
686 $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
687 [^\n]+\n # Another line
688 [^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods]
690 verify_contiguous($name, $makefile, 'copy rules');
691 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
693 # Looking for rules like this:
694 # - If F$Search("[.pod]perldelta.pod").nes."" Then Delete/NoConfirm/Log [.pod]perldelta.pod;*
695 $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;
696 verify_contiguous($name, $makefile, 'delete rules');
697 $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/se;
704 my $makefile_SH = join '', @_;
705 die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
707 $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
708 {join ' ', $1, map "pod/$_",
709 sort keys %Copies, grep {!/perltoc/} keys %Generated
712 # pod/perldelta.pod: pod/perl511delta.pod
713 # cd pod && $(LNS) perl511delta.pod perldelta.pod
716 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
717 \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
720 verify_contiguous($name, $makefile_SH, 'copy rules');
722 my @copy_rules = map "
723 pod/$_: pod/$Copies{$_}
724 \$(LNS) $Copies{$_} pod/$_
727 $makefile_SH =~ s/\0+/join '', @copy_rules/se;
735 while (my ($target, $name) = each %Targets) {
736 next unless $Build{$target};
738 if ($target eq "toc") {
739 print "Now processing $name\n" if $Verbose;
741 print "Finished\n" if $Verbose;
744 print "Now processing $name\n" if $Verbose;
745 open THING, $name or die "Can't open $name: $!";
747 my $orig = join '', @orig;
751 &{"do_$target"}($target, @orig);
753 my $new = join '', @new;
755 print "Was not modified\n" if $Verbose;
758 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
759 open THING, ">$name" or die "$0: Can't open $name for writing: $!";
760 print THING $new or die "$0: print to $name failed: $!";
761 close THING or die die "$0: close $name failed: $!";
764 warn "$0: was not instructed to build anything\n" unless $built;