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)!;
206 die "$0: tut $File::Find::name" if $file =~ /TUT/;
207 unless (open (F, "< $_\0")) {
208 warn "$0: bogus <$file>: $!";
209 system "ls", "-l", $file;
213 while ($line = <F>) {
214 if ($line =~ /^=head1\s+NAME\b/) {
215 push @modpods, $file;
216 #warn "GOOD $file\n";
220 warn "$0: $file: cannot find =head1 NAME\n";
225 die "$0: no pods" unless @modpods;
229 #($name) = /(\w+)\.p(m|od)$/;
230 my $name = path2modname($_);
231 if ($name =~ /^[a-z]/) {
232 $Pragmata{$name} = $_;
234 if ($done{$name}++) {
235 # warn "already did $_\n";
238 $Modules{$name} = $_;
243 # OK. Now a lot of ancillay function definitions follow
244 # Main program returns at "Do stuff"
258 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
262 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
265 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
266 # This file is autogenerated by buildtoc from all the other pods.
267 # 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);
348 if (s/^=head1 (NAME)\s*/=head2 /) {
349 $pod = path2modname($ARGV);
351 output "\n \n\n=head2 ";
353 if ( /^\s*$pod\b/ ) {
354 s/$pod\.pm/$pod/; # '.pm' in NAME !?
362 if (s/^=head1 (.*)/=item $1/) {
364 output "=over 4\n\n" unless $inhead1;
366 output $_; nl(); next;
368 if (s/^=head2 (.*)/=item $1/) {
370 output "=over 4\n\n" unless $inhead2;
372 output $_; nl(); next;
374 if (s/^=item ([^=].*)/$1/) {
375 next if $pod eq 'perldiag';
376 s/^\s*\*\s*$// && next;
381 next if $pod eq 'perlmodlib' && /^ftp:/;
382 ##print "=over 4\n\n" unless $initem;
383 output ", " if $initem;
389 if (s/^=cut\s*\n//) {
399 output "\n\n=back\n\n";
407 output "\n\n=back\n\n";
415 ##print "\n\n=back\n\n";
424 my $NEWLINE = 0; # how many newlines have we seen recently
425 my $LINE; # what remains to be printed
428 for (split /(\n)/, shift) {
431 print OUT wrap('', '', $LINE);
434 if (($NEWLINE) < 2) {
439 elsif (/\S/ && length) {
446 # End of original buildtoc. From here on are routines to generate new sections
447 # for and inplace edit other files
449 sub generate_perlpod {
454 next if $flags->{aux};
458 push @output, "=head2 $_->[1]\n";
461 my $start = " " x (4 + $flags->{indent}) . $_->[1];
462 $maxlength = length $start if length ($start) > $maxlength;
463 push @output, [$start, $_->[2]];
468 die "$0: Illegal length " . scalar @$_;
471 # want at least 2 spaces padding
473 $maxlength = ($maxlength + 3) & ~3;
474 # sprintf gives $1.....$2 where ... are spaces:
475 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
480 sub generate_manifest {
481 # Annyoingly unexpand doesn't consider it good form to replace a single
482 # space before a tab with a tab
483 # Annoyingly (2) it returns read only values.
484 my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
485 map {s/ \t/\t\t/g; $_} @temp;
487 sub generate_manifest_pod {
488 generate_manifest map {["pod/$_.pod", $Pods{$_}]} sort keys %Pods;
490 sub generate_manifest_readme {
491 generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
494 sub generate_roffitall {
495 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
497 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
499 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
501 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
505 sub generate_descrip_mms_1 {
506 local $Text::Wrap::columns = 150;
508 my @lines = map {"pod" . $count++ . " = $_"}
509 split /\n/, wrap('', '', join " ", map "[.lib.pod]$_.pod",
510 sort keys %Pods, keys %Readmepods);
511 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
514 sub generate_descrip_mms_2 {
515 map {sprintf <<'SNIP', $_, $_}
516 [.lib.pod]%s.pod : [.pod]%s.pod
517 @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
518 Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
520 sort keys %Pods, keys %Readmepods;
523 sub generate_nmake_1 {
524 map {sprintf "\tcopy ..\\README.%-8s .\\perl$_.pod\n", $_}
528 # This doesn't have a trailing newline
529 sub generate_nmake_2 {
530 # Spot the special case
531 local $Text::Wrap::columns = 76;
532 my $line = wrap ("\t ", "\t ",
533 join " ", sort map {"perl$_.pod"} "vms", keys %Readmes);
538 sub generate_pod_mak {
539 my $variable = shift;
541 my $line = join "\\\n", "\U$variable = ",
542 map {"\t$_.$variable\t"} sort keys %Pods;
544 $line =~ s/.*perltoc.html.*\n//m;
551 grep {! m!^pod/[^.]+\.pod.*\n!}
552 grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
553 # Dictionary order - fold and handle non-word chars as nothing
555 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
556 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
558 &generate_manifest_pod(),
559 &generate_manifest_readme();
564 my $makefile = join '', @_;
565 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
566 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
567 my $sections = () = $makefile =~ m/\0+/g;
568 die "$0: $name contains no README copies" if $sections < 1;
569 die "$0: $name contains discontiguous README copies" if $sections > 1;
570 $makefile =~ s/\0+/join "", &generate_nmake_1/se;
572 $makefile =~ s{(cd \$\(PODDIR\) && del /f [^\n]+).*?(pod2html)}
573 {"$1\n" . &generate_nmake_2."\n\t $2"}se;
577 # shut up used only once warning
578 *do_dmake = *do_dmake = \&do_nmake;
582 my $pod = join '', @_;
584 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
585 (?:\s+[a-z]{4,}.*\n # fooo
586 |=head.*\n # =head foo
590 {$1 . join "", &generate_perlpod}mxe) {
591 die "$0: Failed to insert ammendments in do_perlpod";
598 my $body = join '', @_;
599 foreach my $variable qw(pod man html tex) {
600 die "$0: could not find $variable in $name"
601 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
602 {"\n" . generate_pod_mak ($variable)}se;
609 my $makefile = join '', @_;
610 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
611 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
612 my $sections = () = $makefile =~ m/\0+/g;
613 die "$0: $name contains no pod assignments" if $sections < 1;
614 die "$0: $name contains $sections discontigous pod assignments"
616 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
618 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
620 # Looking for rules like this
621 # [.lib.pod]perl.pod : [.pod]perl.pod
622 # @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
623 # Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
625 $makefile =~ s/\n\Q[.lib.pod]\Eperl[^\n\.]*\.pod[^\n]+\n
626 [^\n]+\n # Another line
627 [^\n]+\Q[.lib.pod]\E\n # ends [.lib.pod]
629 $sections = () = $makefile =~ m/\0+/g;
630 die "$0: $name contains no copy rules" if $sections < 1;
631 die "$0: $name contains $sections discontigous copy rules"
633 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
640 while (my ($target, $name) = each %Targets) {
641 next unless $Build{$target};
643 if ($target eq "toc") {
647 print "Now processing $name\n" if $Verbose;
648 open THING, $name or die "Can't open $name: $!";
650 my $orig = join '', @orig;
654 &{"do_$target"}($target, @orig);
656 my $new = join '', @new;
658 print "Was not modified\n" if $Verbose;
661 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
662 open THING, ">$name" or die "$0: Can't open $name for writing: $!";
663 print THING $new or die "$0: print to $name failed: $!";
664 close THING or die die "$0: close $name failed: $!";
667 warn "$0: was not instructed to build anything\n" unless $built;