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($_);
264 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
265 # This file is autogenerated by buildtoc from all the other pods.
266 # Edit those files and run buildtoc --build-toc to effect changes.
270 perltoc - perl documentation table of contents
274 This page provides a brief table of contents for the rest of the Perl
275 documentation set. It is meant to be scanned quickly or grepped
276 through to locate the proper section you're looking for.
278 =head1 BASIC DOCUMENTATION
283 # All the things in the master list that happen to be pod filenames
284 podset(map {"$_->[1].pod"} grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master);
287 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
291 =head1 PRAGMA DOCUMENTATION
295 podset(sort values %Pragmata);
297 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
301 =head1 MODULE DOCUMENTATION
305 podset( @Modules{ sort keys %Modules } );
310 =head1 AUXILIARY DOCUMENTATION
312 Here should be listed all the extra programs' documentation, but they
313 don't all have manual pages yet:
319 $_ .= join "\n", map {"\t=item $_\n"} sort keys %Aux;
326 Larry Wall <F<larry\@wall.org>>, with the help of oodles
334 output "\n"; # flush $LINE
337 # Below are all the auxiliary routines for generating perltoc.pod
339 my ($inhead1, $inhead2, $initem);
346 if (s/^=head1 (NAME)\s*/=head2 /) {
347 $pod = path2modname($ARGV);
349 output "\n \n\n=head2 ";
351 if ( /^\s*$pod\b/ ) {
352 s/$pod\.pm/$pod/; # '.pm' in NAME !?
360 if (s/^=head1 (.*)/=item $1/) {
362 output "=over 4\n\n" unless $inhead1;
364 output $_; nl(); next;
366 if (s/^=head2 (.*)/=item $1/) {
368 output "=over 4\n\n" unless $inhead2;
370 output $_; nl(); next;
372 if (s/^=item ([^=].*)/$1/) {
373 next if $pod eq 'perldiag';
374 s/^\s*\*\s*$// && next;
379 next if $pod eq 'perlmodlib' && /^ftp:/;
380 ##print "=over 4\n\n" unless $initem;
381 output ", " if $initem;
387 if (s/^=cut\s*\n//) {
397 output "\n\n=back\n\n";
405 output "\n\n=back\n\n";
413 ##print "\n\n=back\n\n";
422 my $NEWLINE = 0; # how many newlines have we seen recently
423 my $LINE; # what remains to be printed
426 for (split /(\n)/, shift) {
429 print OUT wrap('', '', $LINE);
432 if (($NEWLINE) < 2) {
437 elsif (/\S/ && length) {
444 # End of original buildtoc. From here on are routines to generate new sections
445 # for and inplace edit other files
447 sub generate_perlpod {
452 next if $flags->{aux};
456 push @output, "=head2 $_->[1]\n";
459 my $start = " " x (4 + $flags->{indent}) . $_->[1];
460 $maxlength = length $start if length ($start) > $maxlength;
461 push @output, [$start, $_->[2]];
466 die "$0: Illegal length " . scalar @$_;
469 # want at least 2 spaces padding
471 $maxlength = ($maxlength + 3) & ~3;
472 # sprintf gives $1.....$2 where ... are spaces:
473 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
478 sub generate_manifest {
479 # Annyoingly unexpand doesn't consider it good form to replace a single
480 # space before a tab with a tab
481 # Annoyingly (2) it returns read only values.
482 my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
483 map {s/ \t/\t\t/g; $_} @temp;
485 sub generate_manifest_pod {
486 generate_manifest map {["pod/$_.pod", $Pods{$_}]} sort keys %Pods;
488 sub generate_manifest_readme {
489 generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
492 sub generate_roffitall {
493 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
495 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
497 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
499 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
503 sub generate_descrip_mms_1 {
504 local $Text::Wrap::columns = 150;
506 my @lines = map {"pod" . $count++ . " = $_"}
507 split /\n/, wrap('', '', join " ", map "[.lib.pod]$_.pod",
508 sort keys %Pods, keys %Readmepods);
509 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
512 sub generate_descrip_mms_2 {
513 map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
514 [.lib.pod]%s.pod : [.%s]%s.pod
515 @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
516 Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
518 sort keys %Pods, keys %Readmepods;
521 sub generate_nmake_1 {
522 map {sprintf "\tcopy ..\\README.%-8s .\\perl$_.pod\n", $_}
526 # This doesn't have a trailing newline
527 sub generate_nmake_2 {
528 # Spot the special case
529 local $Text::Wrap::columns = 76;
530 my $line = wrap ("\t ", "\t ",
531 join " ", sort map {"perl$_.pod"} "vms", keys %Readmes);
536 sub generate_pod_mak {
537 my $variable = shift;
539 my $line = join "\\\n", "\U$variable = ",
540 map {"\t$_.$variable\t"} sort keys %Pods;
542 $line =~ s/.*perltoc.html.*\n//m;
549 grep {! m!^pod/[^.]+\.pod.*\n!}
550 grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
551 # Dictionary order - fold and handle non-word chars as nothing
553 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
554 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
556 &generate_manifest_pod(),
557 &generate_manifest_readme();
562 my $makefile = join '', @_;
563 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
564 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
565 my $sections = () = $makefile =~ m/\0+/g;
566 die "$0: $name contains no README copies" if $sections < 1;
567 die "$0: $name contains discontiguous README copies" if $sections > 1;
568 $makefile =~ s/\0+/join "", &generate_nmake_1/se;
570 $makefile =~ s{(cd \$\(PODDIR\) && del /f [^\n]+).*?(pod2html)}
571 {"$1\n" . &generate_nmake_2."\n\t $2"}se;
575 # shut up used only once warning
576 *do_dmake = *do_dmake = \&do_nmake;
580 my $pod = join '', @_;
582 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
583 (?:\s+[a-z]{4,}.*\n # fooo
584 |=head.*\n # =head foo
588 {$1 . join "", &generate_perlpod}mxe) {
589 die "$0: Failed to insert ammendments in do_perlpod";
596 my $body = join '', @_;
597 foreach my $variable qw(pod man html tex) {
598 die "$0: could not find $variable in $name"
599 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
600 {"\n" . generate_pod_mak ($variable)}se;
607 my $makefile = join '', @_;
608 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
609 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
610 my $sections = () = $makefile =~ m/\0+/g;
611 die "$0: $name contains no pod assignments" if $sections < 1;
612 die "$0: $name contains $sections discontigous pod assignments"
614 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
616 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
618 # Looking for rules like this
619 # [.lib.pod]perl.pod : [.pod]perl.pod
620 # @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
621 # Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
623 $makefile =~ s/\n\Q[.lib.pod]\Eperl[^\n\.]*\.pod[^\n]+\n
624 [^\n]+\n # Another line
625 [^\n]+\Q[.lib.pod]\E\n # ends [.lib.pod]
627 $sections = () = $makefile =~ m/\0+/g;
628 die "$0: $name contains no copy rules" if $sections < 1;
629 die "$0: $name contains $sections discontigous copy rules"
631 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
638 while (my ($target, $name) = each %Targets) {
639 next unless $Build{$target};
641 if ($target eq "toc") {
645 print "Now processing $name\n" if $Verbose;
646 open THING, $name or die "Can't open $name: $!";
648 my $orig = join '', @orig;
652 &{"do_$target"}($target, @orig);
654 my $new = join '', @new;
656 print "Was not modified\n" if $Verbose;
659 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
660 open THING, ">$name" or die "$0: Can't open $name for writing: $!";
661 print THING $new or die "$0: print to $name failed: $!";
662 close THING or die die "$0: close $name failed: $!";
665 warn "$0: was not instructed to build anything\n" unless $built;