4 use vars qw($masterpodfile %Build %Targets $Verbose $Up %Ignore
5 @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
16 $Up = File::Spec->updir;
17 $masterpodfile = File::Spec->catdir($Up, "pod.lst");
19 # Generate any/all of these files
20 # --verbose gives slightly more output
21 # --build-all tries to build everything
22 # --build-foo updates foo as follows
23 # --showfiles shows the files to be changed
28 manifest => File::Spec->catdir($Up, "MANIFEST"),
29 perlpod => "perl.pod",
30 vms => File::Spec->catdir($Up, "vms", "descrip_mms.template"),
31 nmake => File::Spec->catdir($Up, "win32", "Makefile"),
32 dmake => File::Spec->catdir($Up, "win32", "makefile.mk"),
33 podmak => File::Spec->catdir($Up, "win32", "pod.mak"),
34 # plan9 => File::Spec->catdir($Up, "plan9", "mkfile"),
35 unix => File::Spec->catdir($Up, "Makefile.SH"),
40 my @files = keys %Targets;
41 my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
44 $0: Usage: $0 [--verbose] [--showfiles] $filesopts
47 && GetOptions (verbose => \$Verbose,
48 showfiles => \$showfiles,
49 map {+"build-$_", \$Build{$_}} @files, 'all');
50 # Set them all to true
51 @Build{@files} = @files if ($Build{all});
55 sort { lc $a cmp lc $b }
57 my ($v, $d, $f) = File::Spec->splitpath($_);
59 @d = defined $d ? File::Spec->splitdir($d) : ();
61 File::Spec->catfile(@d ?
62 (@d == 1 && $d[0] eq '' ? () : @d)
64 } @Targets{grep { $_ ne 'all' && $Build{$_} } keys %Build}),
70 # Don't copy these top level READMEs
78 print "I'm building $_\n" foreach grep {$Build{$_}} keys %Build;
81 chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";
83 open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!";
85 my ($delta_source, $delta_target);
90 # At least one upper case letter somewhere in the first group
91 if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
95 my %flags = (header => 1);
96 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
97 $flags{aux} = 1 if $flags =~ tr/a//d;
98 die "$0: Unknown flag found in heading line: $_" if length $flags;
99 push @Master, [\%flags, $2];
101 } elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
103 my ($flags, $filename, $desc) = ($1, $2, $3);
105 my %flags = (indent => 0);
106 $flags{indent} = $1 if $flags =~ s/(\d+)//;
107 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
108 $flags{aux} = 1 if $flags =~ tr/a//d;
110 if ($flags =~ tr/D//d) {
111 $flags{perlpod_omit} = 1;
112 $delta_source = "$filename.pod";
114 if ($flags =~ tr/d//d) {
115 $flags{manifest_omit} = 1;
116 $delta_target = "$filename.pod";
119 if ($flags =~ tr/r//d) {
120 my $readme = $filename;
121 $readme =~ s/^perl//;
122 $Readmepods{$filename} = $Readmes{$readme} = $desc;
124 } elsif ($flags{aux}) {
125 $Aux{$filename} = $desc;
127 $Pods{$filename} = $desc;
129 die "$0: Unknown flag found in section line: $_" if length $flags;
130 push @Master, [\%flags, $filename, $desc];
134 die "$0: Malformed line: $_" if $1 =~ tr/A-Z//;
137 if (defined $delta_source) {
138 if (defined $delta_target) {
139 # This way round so that keys can act as a MANIFEST skip list
140 # Targets will aways be in the pod directory. Currently we can only cope
141 # with sources being in the same directory. Fix this and do perlvms.pod
143 $Copies{$delta_target} = $delta_source;
145 die "$0: delta source defined but not target";
147 } elsif (defined $delta_target) {
148 die "$0: delta target defined but not target";
155 my (%disk_pods, @disk_pods);
156 my (@manipods, %manipods);
157 my (@manireadmes, %manireadmes);
158 my (@perlpods, %perlpods);
162 # Convert these to a list of filenames.
163 foreach (keys %Pods, keys %Readmepods) {
164 $our_pods{"$_.pod"}++;
167 # None of these filenames will be boolean false
168 @disk_pods = glob("*.pod");
169 @disk_pods{@disk_pods} = @disk_pods;
171 # Things we copy from won't be in perl.pod
172 # Things we copy to won't be in MANIFEST
173 @sources{values %Copies} = ();
175 open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
177 if (m!^pod/([^.]+\.pod)\s+!i) {
179 } elsif (m!^README\.(\S+)\s+!i) {
181 push @manireadmes, "perl$1.pod";
185 @manipods{@manipods} = @manipods;
186 @manireadmes{@manireadmes} = @manireadmes;
188 open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
190 if (/^For ease of access, /../^\(If you're intending /) {
191 if (/^\s+(perl\S*)\s+\w/) {
192 push @perlpods, "$1.pod";
197 die "$0: could not find the pod listing of perl.pod\n"
199 @perlpods{@perlpods} = @perlpods;
201 foreach my $i (sort keys %disk_pods) {
202 warn "$0: $i exists but is unknown by buildtoc\n"
203 unless $our_pods{$i};
204 warn "$0: $i exists but is unknown by ../MANIFEST\n"
205 if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i};
206 warn "$0: $i exists but is unknown by perl.pod\n"
207 if !$perlpods{$i} && !exists $sources{$i};
209 foreach my $i (sort keys %our_pods) {
210 warn "$0: $i is known by buildtoc but does not exist\n"
211 unless $disk_pods{$i};
213 foreach my $i (sort keys %manipods) {
214 warn "$0: $i is known by ../MANIFEST but does not exist\n"
215 unless $disk_pods{$i};
217 foreach my $i (sort keys %perlpods) {
218 warn "$0: $i is known by perl.pod but does not exist\n"
219 unless $disk_pods{$i};
223 # Find all the mdoules
226 find \&getpods => qw(../lib ../ext);
230 my $file = $File::Find::name;
231 return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
232 return if $file =~ m!(?:^|/)t/!;
233 return if $file =~ m!lib/Attribute/Handlers/demo/!;
234 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
235 return if $file =~ m!lib/Math/BigInt/t/!;
236 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
237 return if $file =~ m!XS/(?:APItest|Typemap)!;
239 return if $pod =~ s/pm$/pod/ && -e $pod;
240 die "$0: tut $File::Find::name" if $file =~ /TUT/;
241 unless (open (F, "< $_\0")) {
242 warn "$0: bogus <$file>: $!";
243 system "ls", "-l", $file;
247 while ($line = <F>) {
248 if ($line =~ /^=head1\s+NAME\b/) {
249 push @modpods, $file;
250 #warn "GOOD $file\n";
254 warn "$0: $file: cannot find =head1 NAME\n";
259 die "$0: no pods" unless @modpods;
263 #($name) = /(\w+)\.p(m|od)$/;
264 my $name = path2modname($_);
265 if ($name =~ /^[a-z]/) {
266 $Pragmata{$name} = $_;
268 if ($done{$name}++) {
269 # warn "already did $_\n";
272 $Modules{$name} = $_;
277 # OK. Now a lot of ancillary function definitions follow
278 # Main program returns at "Do stuff"
292 open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
296 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
298 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
299 # This file is autogenerated by buildtoc from all the other pods.
300 # Edit those files and run buildtoc --build-toc to effect changes.
304 perltoc - perl documentation table of contents
308 This page provides a brief table of contents for the rest of the Perl
309 documentation set. It is meant to be scanned quickly or grepped
310 through to locate the proper section you're looking for.
312 =head1 BASIC DOCUMENTATION
317 # All the things in the master list that happen to be pod filenames
318 podset(map {"$_->[1].pod"} grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master);
321 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
325 =head1 PRAGMA DOCUMENTATION
329 podset(sort values %Pragmata);
331 ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
335 =head1 MODULE DOCUMENTATION
339 podset( @Modules{ sort keys %Modules } );
344 =head1 AUXILIARY DOCUMENTATION
346 Here should be listed all the extra programs' documentation, but they
347 don't all have manual pages yet:
353 $_ .= join "\n", map {"\t=item $_\n"} sort keys %Aux;
360 Larry Wall <F<larry\@wall.org>>, with the help of oodles
368 output "\n"; # flush $LINE
371 # Below are all the auxiliary routines for generating perltoc.pod
373 my ($inhead1, $inhead2, $initem);
381 if (s/^=head1 (NAME)\s*/=head2 /) {
382 $pod = path2modname($ARGV);
384 output "\n \n\n=head2 ";
386 # Remove svn keyword expansions from the Perl FAQ
387 s/ \(\$Revision: \d+ \$\)//g;
388 if ( /^\s*$pod\b/ ) {
389 s/$pod\.pm/$pod/; # '.pm' in NAME !?
397 if (s/^=head1 (.*)/=item $1/) {
399 output "=over 4\n\n" unless $inhead1;
401 output $_; nl(); next;
403 if (s/^=head2 (.*)/=item $1/) {
405 output "=over 4\n\n" unless $inhead2;
407 output $_; nl(); next;
409 if (s/^=item ([^=].*)/$1/) {
410 next if $pod eq 'perldiag';
411 s/^\s*\*\s*$// && next;
416 next if $pod eq 'perlmodlib' && /^ftp:/;
417 ##print "=over 4\n\n" unless $initem;
418 output ", " if $initem;
424 if (s/^=cut\s*\n//) {
434 output "\n\n=back\n\n";
442 output "\n\n=back\n\n";
450 ##print "\n\n=back\n\n";
459 my $NEWLINE = 0; # how many newlines have we seen recently
460 my $LINE; # what remains to be printed
463 for (split /(\n)/, shift) {
466 print OUT wrap('', '', $LINE);
469 if (($NEWLINE) < 2) {
474 elsif (/\S/ && length) {
481 # End of original buildtoc. From here on are routines to generate new sections
482 # for and inplace edit other files
484 sub generate_perlpod {
489 next if $flags->{aux};
490 next if $flags->{perlpod_omit};
494 push @output, "=head2 $_->[1]\n";
497 my $start = " " x (4 + $flags->{indent}) . $_->[1];
498 $maxlength = length $start if length ($start) > $maxlength;
499 push @output, [$start, $_->[2]];
504 die "$0: Illegal length " . scalar @$_;
507 # want at least 2 spaces padding
509 $maxlength = ($maxlength + 3) & ~3;
510 # sprintf gives $1.....$2 where ... are spaces:
511 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
516 sub generate_manifest {
517 # Annyoingly unexpand doesn't consider it good form to replace a single
518 # space before a tab with a tab
519 # Annoyingly (2) it returns read only values.
520 my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
521 map {s/ \t/\t\t/g; $_} @temp;
523 sub generate_manifest_pod {
524 generate_manifest map {["pod/$_.pod", $Pods{$_}]}
525 grep {!$Copies{"$_.pod"}} sort keys %Pods;
527 sub generate_manifest_readme {
528 generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
531 sub generate_roffitall {
532 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
534 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
536 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
538 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
542 sub generate_descrip_mms_1 {
543 local $Text::Wrap::columns = 150;
545 my @lines = map {"pod" . $count++ . " = $_"}
546 split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
547 sort keys %Pods, keys %Readmepods);
548 @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
551 sub generate_descrip_mms_2 {
552 map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
553 [.lib.pods]%s.pod : [.%s]%s.pod
554 @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
555 Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
557 sort keys %Pods, keys %Readmepods;
560 sub generate_nmake_1 {
561 # XXX Fix this with File::Spec
562 (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
564 (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
567 # This doesn't have a trailing newline
568 sub generate_nmake_2 {
569 # Spot the special case
570 local $Text::Wrap::columns = 76;
571 my $line = wrap ("\t ", "\t ",
572 join " ", sort keys %Copies,
573 map {"perl$_.pod"} "vms", keys %Readmes);
578 sub generate_pod_mak {
579 my $variable = shift;
581 my $line = join "\\\n", "\U$variable = ",
582 map {"\t$_.$variable\t"} sort keys %Pods;
584 $line =~ s/.*perltoc.html.*\n//m;
591 grep {! m!^pod/[^.]+\.pod.*\n!}
592 grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
593 # Dictionary order - fold and handle non-word chars as nothing
595 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
596 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
598 &generate_manifest_pod(),
599 &generate_manifest_readme();
604 my $makefile = join '', @_;
605 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
606 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
607 my $sections = () = $makefile =~ m/\0+/g;
608 die "$0: $name contains no README copies" if $sections < 1;
609 die "$0: $name contains discontiguous README copies" if $sections > 1;
610 # Now remove the other copies that follow
611 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
612 $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
614 $makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
615 {"$1\n" . &generate_nmake_2."\n\t $2"}se;
619 # shut up used only once warning
620 *do_dmake = *do_dmake = \&do_nmake;
624 my $pod = join '', @_;
626 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
627 (?:\s+[a-z]{4,}.*\n # fooo
628 |=head.*\n # =head foo
632 {$1 . join "", &generate_perlpod}mxe) {
633 die "$0: Failed to insert amendments in do_perlpod";
640 my $body = join '', @_;
641 foreach my $variable (qw(pod man html tex)) {
642 die "$0: could not find $variable in $name"
643 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
644 {"\n" . generate_pod_mak ($variable)}se;
651 my $makefile = join '', @_;
652 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
653 $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
654 my $sections = () = $makefile =~ m/\0+/g;
655 die "$0: $name contains no pod assignments" if $sections < 1;
656 die "$0: $name contains $sections discontigous pod assignments"
658 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
660 die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
662 # Looking for rules like this
663 # [.lib.pods]perl.pod : [.pod]perl.pod
664 # @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
665 # Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
667 $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
668 [^\n]+\n # Another line
669 [^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods]
671 $sections = () = $makefile =~ m/\0+/g;
672 die "$0: $name contains no copy rules" if $sections < 1;
673 die "$0: $name contains $sections discontigous copy rules"
675 $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
681 my $makefile_SH = join '', @_;
682 die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
684 $makefile_SH =~ s/\n\s+-\@test -f \S+ && cd pod && \$\(LNS\) \S+ \S+ && cd \.\. && echo "\S+" >> extra.pods \# See buildtoc\n/\0/gm;
686 my $sections = () = $makefile_SH =~ m/\0+/g;
688 die "$0: $name contains no copy rules" if $sections < 1;
689 die "$0: $name contains $sections discontigous copy rules"
692 my @copy_rules = map "\t-\@test -f pod/$Copies{$_} && cd pod && \$(LNS) $Copies{$_} $_ && cd .. && echo \"pod/$_\" >> extra.pods # See buildtoc",
695 $makefile_SH =~ s/\0+/join "\n", '', @copy_rules, ''/se;
703 while (my ($target, $name) = each %Targets) {
704 next unless $Build{$target};
706 if ($target eq "toc") {
707 print "Now processing $name\n" if $Verbose;
709 print "Finished\n" if $Verbose;
712 print "Now processing $name\n" if $Verbose;
713 open THING, $name or die "Can't open $name: $!";
715 my $orig = join '', @orig;
719 &{"do_$target"}($target, @orig);
721 my $new = join '', @new;
723 print "Was not modified\n" if $Verbose;
726 rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
727 open THING, ">$name" or die "$0: Can't open $name for writing: $!";
728 print THING $new or die "$0: print to $name failed: $!";
729 close THING or die die "$0: close $name failed: $!";
732 warn "$0: was not instructed to build anything\n" unless $built;