4 use vars qw($masterpodfile %Build %Targets $Verbose $Up %Ignore
5 @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules);
15 $Up = File::Spec->updir;
16 $masterpodfile = File::Spec->catdir($Up, "pod.lst");
18 # Generate any/all of these files
19 # --verbose gives slightly more output
20 # --build-all tries to build everything
21 # --build-foo updates foo as follows
22 # --showfiles shows the files to be changed
27 manifest => File::Spec->catdir($Up, "MANIFEST"),
28 perlpod => "perl.pod",
29 vms => File::Spec->catdir($Up, "vms", "descrip_mms.template"),
30 nmake => File::Spec->catdir($Up, "win32", "Makefile"),
31 dmake => File::Spec->catdir($Up, "win32", "makefile.mk"),
32 podmak => File::Spec->catdir($Up, "win32", "pod.mak"),
33 # plan9 => File::Spec->catdir($Up, "plan9", "mkfile"),
37 my @files = keys %Targets;
38 my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
41 $0: Usage: $0 [--verbose] [--showfiles] $filesopts
44 && GetOptions (verbose => \$Verbose,
45 showfiles => \$showfiles,
46 map {+"build-$_", \$Build{$_}} @files, 'all');
47 # Set them all to true
48 @Build{@files} = @files if ($Build{all});
52 sort { lc $a cmp lc $b }
54 my ($v, $d, $f) = File::Spec->splitpath($_);
56 @d = defined $d ? File::Spec->splitdir($d) : ();
58 File::Spec->catfile(@d ?
59 (@d == 1 && $d[0] eq '' ? () : @d)
61 } @Targets{grep { $_ ne 'all' && $Build{$_} } keys %Build}),
67 # Don't copy these top level READMEs
76 print "I'm building $_\n" foreach grep {$Build{$_}} keys %Build;
79 chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";
81 open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!";
86 # At least one upper case letter somewhere in the first group
87 if (/^(\S+)\s(.*)/ && $1 =~ tr/A-Z//) {
90 my %flags = (header => 1);
91 $flags{toc_omit} = 1 if $flags =~ tr/O//d;
92 $flags{include} = 1 if $flags =~ tr/I//d;
93 $flags{aux} = 1 if $flags =~ tr/A//d;
94 die "$0: Unknown flag found in heading line: $_" if length $flags;
95 push @Master, [\%flags, $2];
97 } elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
99 my ($flags, $filename, $desc) = ($1, $2, $3);
101 my %flags = (indent => 0);
102 $flags{indent} = $1 if $flags =~ s/(\d+)//;
103 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
104 $flags{aux} = 1 if $flags =~ tr/a//d;
105 if ($flags =~ tr/r//d) {
106 my $readme = $filename;
107 $readme =~ s/^perl//;
108 $Readmepods{$filename} = $Readmes{$readme} = $desc;
110 } elsif ($flags{aux}) {
111 $Aux{$filename} = $desc;
113 $Pods{$filename} = $desc;
115 die "$0: Unknown flag found in section line: $_" if length $flags;
116 push @Master, [\%flags, $filename, $desc];
120 die "$0: Malformed line: $_" if $1 =~ tr/A-Z//;
128 my (%disk_pods, @disk_pods);
129 my (@manipods, %manipods);
130 my (@manireadmes, %manireadmes);
131 my (@perlpods, %perlpods);
134 # Convert these to a list of filenames.
135 foreach (keys %Pods, keys %Readmepods) {
136 $our_pods{"$_.pod"}++;
139 # None of these filenames will be boolean false
140 @disk_pods = glob("*.pod");
141 @disk_pods{@disk_pods} = @disk_pods;
143 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
145 if (m!^pod/([^.]+\.pod)\s+!i) {
147 } elsif (m!^README\.(\S+)\s+!i) {
149 push @manireadmes, "perl$1.pod";
153 @manipods{@manipods} = @manipods;
154 @manireadmes{@manireadmes} = @manireadmes;
156 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
158 if (/^For ease of access, /../^\(If you're intending /) {
159 if (/^\s+(perl\S*)\s+\w/) {
160 push @perlpods, "$1.pod";
165 die "$0: could not find the pod listing of perl.pod\n"
167 @perlpods{@perlpods} = @perlpods;
169 foreach my $i (sort keys %disk_pods) {
170 warn "$0: $i exists but is unknown by buildtoc\n"
171 unless $our_pods{$i};
172 warn "$0: $i exists but is unknown by ../MANIFEST\n"
173 if !$manipods{$i} && !$manireadmes{$i};
174 warn "$0: $i exists but is unknown by perl.pod\n"
175 unless $perlpods{$i};
177 foreach my $i (sort keys %our_pods) {
178 warn "$0: $i is known by buildtoc but does not exist\n"
179 unless $disk_pods{$i};
181 foreach my $i (sort keys %manipods) {
182 warn "$0: $i is known by ../MANIFEST but does not exist\n"
183 unless $disk_pods{$i};
185 foreach my $i (sort keys %perlpods) {
186 warn "$0: $i is known by perl.pod but does not exist\n"
187 unless $disk_pods{$i};
191 # Find all the mdoules
194 find \&getpods => qw(../lib ../ext);
198 my $file = $File::Find::name;
199 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
200 return if $file =~ m!(?:^|/)t/!;
201 return if $file =~ m!lib/Attribute/Handlers/demo/!;
202 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
203 return if $file =~ m!lib/Math/BigInt/t/!;
204 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
205 return if $file =~ m!XS/(?:APItest|Typemap)!;
207 return if $pod =~ s/pm$/pod/ && -e $pod;
208 die "$0: tut $File::Find::name" if $file =~ /TUT/;
209 unless (open (F, "< $_\0")) {
210 warn "$0: bogus <$file>: $!";
211 system "ls", "-l", $file;
215 while ($line = <F>) {
216 if ($line =~ /^=head1\s+NAME\b/) {
217 push @modpods, $file;
218 #warn "GOOD $file\n";
222 warn "$0: $file: cannot find =head1 NAME\n";
227 die "$0: no pods" unless @modpods;
231 #($name) = /(\w+)\.p(m|od)$/;
232 my $name = path2modname($_);
233 if ($name =~ /^[a-z]/) {
234 $Pragmata{$name} = $_;
236 if ($done{$name}++) {
237 # warn "already did $_\n";
240 $Modules{$name} = $_;
245 # OK. Now a lot of ancillay function definitions follow
246 # Main program returns at "Do stuff"
260 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
264 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
266 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
267 # This file is autogenerated by buildtoc from all the other pods.
268 # Edit those files and run buildtoc --build-toc to effect changes.
272 perltoc - perl documentation table of contents
276 This page provides a brief table of contents for the rest of the Perl
277 documentation set. It is meant to be scanned quickly or grepped
278 through to locate the proper section you're looking for.
280 =head1 BASIC DOCUMENTATION
285 # All the things in the master list that happen to be pod filenames
286 podset(map {"$_->[1].pod"} grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master);
289 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
293 =head1 PRAGMA DOCUMENTATION
297 podset(sort values %Pragmata);
299 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
303 =head1 MODULE DOCUMENTATION
307 podset( @Modules{ sort keys %Modules } );
312 =head1 AUXILIARY DOCUMENTATION
314 Here should be listed all the extra programs' documentation, but they
315 don't all have manual pages yet:
321 $_ .= join "\n", map {"\t=item $_\n"} sort keys %Aux;
328 Larry Wall <F<larry\@wall.org>>, with the help of oodles
336 output "\n"; # flush $LINE
339 # Below are all the auxiliary routines for generating perltoc.pod
341 my ($inhead1, $inhead2, $initem);
349 if (s/^=head1 (NAME)\s*/=head2 /) {
350 $pod = path2modname($ARGV);
352 output "\n \n\n=head2 ";
354 if ( /^\s*$pod\b/ ) {
355 s/$pod\.pm/$pod/; # '.pm' in NAME !?
363 if (s/^=head1 (.*)/=item $1/) {
365 output "=over 4\n\n" unless $inhead1;
367 output $_; nl(); next;
369 if (s/^=head2 (.*)/=item $1/) {
371 output "=over 4\n\n" unless $inhead2;
373 output $_; nl(); next;
375 if (s/^=item ([^=].*)/$1/) {
376 next if $pod eq 'perldiag';
377 s/^\s*\*\s*$// && next;
382 next if $pod eq 'perlmodlib' && /^ftp:/;
383 ##print "=over 4\n\n" unless $initem;
384 output ", " if $initem;
390 if (s/^=cut\s*\n//) {
400 output "\n\n=back\n\n";
408 output "\n\n=back\n\n";
416 ##print "\n\n=back\n\n";
425 my $NEWLINE = 0; # how many newlines have we seen recently
426 my $LINE; # what remains to be printed
429 for (split /(\n)/, shift) {
432 print OUT wrap('', '', $LINE);
435 if (($NEWLINE) < 2) {
440 elsif (/\S/ && length) {
447 # End of original buildtoc. From here on are routines to generate new sections
448 # for and inplace edit other files
450 sub generate_perlpod {
455 next if $flags->{aux};
459 push @output, "=head2 $_->[1]\n";
462 my $start = " " x (4 + $flags->{indent}) . $_->[1];
463 $maxlength = length $start if length ($start) > $maxlength;
464 push @output, [$start, $_->[2]];
469 die "$0: Illegal length " . scalar @$_;
472 # want at least 2 spaces padding
474 $maxlength = ($maxlength + 3) & ~3;
475 # sprintf gives $1.....$2 where ... are spaces:
476 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
481 sub generate_manifest {
482 # Annyoingly unexpand doesn't consider it good form to replace a single
483 # space before a tab with a tab
484 # Annoyingly (2) it returns read only values.
485 my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
486 map {s/ \t/\t\t/g; $_} @temp;
488 sub generate_manifest_pod {
489 generate_manifest map {["pod/$_.pod", $Pods{$_}]} sort keys %Pods;
491 sub generate_manifest_readme {
492 generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
495 sub generate_roffitall {
496 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
498 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
500 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
502 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
506 sub generate_descrip_mms_1 {
507 local $Text::Wrap::columns = 150;
509 my @lines = map {"pod" . $count++ . " = $_"}
510 split /\n/, wrap('', '', join " ", map "[.lib.pod]$_.pod",
511 sort keys %Pods, keys %Readmepods);
512 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
515 sub generate_descrip_mms_2 {
516 map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
517 [.lib.pod]%s.pod : [.%s]%s.pod
518 @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
519 Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
521 sort keys %Pods, keys %Readmepods;
524 sub generate_nmake_1 {
525 map {sprintf "\tcopy ..\\README.%-8s .\\perl$_.pod\n", $_}
529 # This doesn't have a trailing newline
530 sub generate_nmake_2 {
531 # Spot the special case
532 local $Text::Wrap::columns = 76;
533 my $line = wrap ("\t ", "\t ",
534 join " ", sort map {"perl$_.pod"} "vms", keys %Readmes);
539 sub generate_pod_mak {
540 my $variable = shift;
542 my $line = join "\\\n", "\U$variable = ",
543 map {"\t$_.$variable\t"} sort keys %Pods;
545 $line =~ s/.*perltoc.html.*\n//m;
552 grep {! m!^pod/[^.]+\.pod.*\n!}
553 grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
554 # Dictionary order - fold and handle non-word chars as nothing
556 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
557 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
559 &generate_manifest_pod(),
560 &generate_manifest_readme();
565 my $makefile = join '', @_;
566 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
567 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
568 my $sections = () = $makefile =~ m/\0+/g;
569 die "$0: $name contains no README copies" if $sections < 1;
570 die "$0: $name contains discontiguous README copies" if $sections > 1;
571 $makefile =~ s/\0+/join "", &generate_nmake_1/se;
573 $makefile =~ s{(cd \$\(PODDIR\) && del /f [^\n]+).*?(pod2html)}
574 {"$1\n" . &generate_nmake_2."\n\t $2"}se;
578 # shut up used only once warning
579 *do_dmake = *do_dmake = \&do_nmake;
583 my $pod = join '', @_;
585 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
586 (?:\s+[a-z]{4,}.*\n # fooo
587 |=head.*\n # =head foo
591 {$1 . join "", &generate_perlpod}mxe) {
592 die "$0: Failed to insert ammendments in do_perlpod";
599 my $body = join '', @_;
600 foreach my $variable (qw(pod man html tex)) {
601 die "$0: could not find $variable in $name"
602 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
603 {"\n" . generate_pod_mak ($variable)}se;
610 my $makefile = join '', @_;
611 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
612 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
613 my $sections = () = $makefile =~ m/\0+/g;
614 die "$0: $name contains no pod assignments" if $sections < 1;
615 die "$0: $name contains $sections discontigous pod assignments"
617 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
619 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
621 # Looking for rules like this
622 # [.lib.pod]perl.pod : [.pod]perl.pod
623 # @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
624 # Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
626 $makefile =~ s/\n\Q[.lib.pod]\Eperl[^\n\.]*\.pod[^\n]+\n
627 [^\n]+\n # Another line
628 [^\n]+\Q[.lib.pod]\E\n # ends [.lib.pod]
630 $sections = () = $makefile =~ m/\0+/g;
631 die "$0: $name contains no copy rules" if $sections < 1;
632 die "$0: $name contains $sections discontigous copy rules"
634 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
641 while (my ($target, $name) = each %Targets) {
642 next unless $Build{$target};
644 if ($target eq "toc") {
648 print "Now processing $name\n" if $Verbose;
649 open THING, $name or die "Can't open $name: $!";
651 my $orig = join '', @orig;
655 &{"do_$target"}($target, @orig);
657 my $new = join '', @new;
659 print "Was not modified\n" if $Verbose;
662 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
663 open THING, ">$name" or die "$0: Can't open $name for writing: $!";
664 print THING $new or die "$0: print to $name failed: $!";
665 close THING or die die "$0: close $name failed: $!";
668 warn "$0: was not instructed to build anything\n" unless $built;