4 use vars qw($masterpodfile %Build %Targets $Verbose $Quiet %Ignore
5 @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
6 %Copies %Generated $Test);
19 my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir);
23 return File::Spec->catdir($Top, split /\//, $path) if $path =~ s!/\z!!;
24 return File::Spec->catfile($Top, split /\//, $path);
28 # make it clearer when we haven't run to completion, as we can be quite
29 # noisy when things are working ok
32 print STDERR "$0: ", @_;
33 print STDERR "\n" unless $_[-1] =~ /\n\z/;
34 print STDERR "ABORTED\n";
39 $masterpodfile = abs_from_top('pod.lst');
41 # Generate any/all of these files
42 # --verbose gives slightly more output
43 # --quiet suppresses routine warnings
44 # --build-all tries to build everything
45 # --build-foo updates foo as follows
46 # --showfiles shows the files to be changed
47 # --test exit if perl.pod, pod.lst, MANIFEST are consistent, and regenerated
48 # files are up to date, die otherwise.
52 toc => 'pod/perltoc.pod',
53 manifest => 'MANIFEST',
54 perlpod => 'pod/perl.pod',
55 vms => 'vms/descrip_mms.template',
56 nmake => 'win32/Makefile',
57 dmake => 'win32/makefile.mk',
58 podmak => 'win32/pod.mak',
59 # plan9 => 'plan9/mkfile'),
60 unix => 'Makefile.SH',
64 foreach (values %Targets) {
65 $_ = abs_from_top($_);
68 # process command-line switches
71 my @files = keys %Targets;
72 my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
76 $0: Usage: $0 [--verbose] [--showfiles] $filesopts
79 && GetOptions (verbose => \$Verbose,
81 showfiles => \$showfiles,
83 map {+"build-$_", \$build_these{$_}} @files, 'all');
84 if ($build_these{all}) {
87 while (my ($file, $want) = each %build_these) {
88 $Build{$file} = $Targets{$file} if $want;
94 sort { lc $a cmp lc $b }
96 my ($v, $d, $f) = File::Spec->splitpath($_);
98 @d = defined $d ? File::Spec->splitdir($d) : ();
100 File::Spec->catfile(@d ?
101 (@d == 1 && $d[0] eq '' ? () : @d)
109 # Don't copy these top level READMEs
117 print "I will be building $_\n" foreach keys %Build;
123 my $source = 'perldelta.pod';
124 my $filename = abs_from_top("pod/$source");
125 open my $fh, '<', $filename or my_die "Can't open $filename: $!";
127 my $contents = <$fh>;
129 $contents =~ /perldelta - what is new for perl v5\.(\d+)\.(\d+)\n/;
130 die "Can't extract version from $filename" unless @want;
131 $delta_target = "perl5$want[0]$want[1]delta.pod";
133 # This way round so that keys can act as a MANIFEST skip list
134 # Targets will always be in the pod directory. Currently we can only cope
135 # with sources being in the same directory.
136 $Copies{$delta_target} = $source;
141 open my $master, '<', $masterpodfile or my_die "Can't open $masterpodfile: $!";
143 foreach (<$master>) {
146 # At least one upper case letter somewhere in the first group
147 if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
151 my %flags = (header => 1);
152 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
153 $flags{aux} = 1 if $flags =~ tr/a//d;
154 my_die "Unknown flag found in heading line: $_" if length $flags;
155 push @Master, [\%flags, $2];
157 } elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
159 my ($flags, $podname, $desc) = ($1, $2, $3);
160 my $filename = "${podname}.pod";
161 $filename = "pod/${filename}" if $filename !~ m{/};
163 my %flags = (indent => 0);
164 $flags{indent} = $1 if $flags =~ s/(\d+)//;
165 $flags{toc_omit} = 1 if $flags =~ tr/o//d;
166 $flags{aux} = 1 if $flags =~ tr/a//d;
167 $flags{perlpod_omit} = "$podname.pod" eq $delta_target;
169 $Generated{"$podname.pod"}++ if $flags =~ tr/g//d;
171 if ($flags =~ tr/r//d) {
172 my $readme = $podname;
173 $readme =~ s/^perl//;
174 $Readmepods{$podname} = $Readmes{$readme} = $desc;
176 } elsif ($flags{aux}) {
177 $Aux{$podname} = $desc;
179 $Pods{$podname} = $desc;
181 my_die "Unknown flag found in section line: $_" if length $flags;
182 my $shortname = $podname =~ s{.*/}{}r;
183 push @Master, [\%flags, $podname, $filename, $desc, $shortname];
187 my_die "Malformed line: $_" if $1 =~ tr/A-Z//;
195 my (%disk_pods, @disk_pods);
196 my (@manipods, %manipods);
197 my (@manireadmes, %manireadmes);
198 my (@perlpods, %perlpods);
199 my (@cpanpods, %cpanpods, %cpanpods_short);
202 # These are stub files for deleted documents. We don't want them to show up
203 # in perl.pod, they just exist so that if someone types "perldoc perltoot"
204 # they get some sort of pointer to the new docs.
206 = map { ( "$_.pod" => 1 ) } qw( perlboot perlbot perltooc perltoot );
208 # Convert these to a list of filenames.
209 foreach (keys %Pods, keys %Readmepods) {
210 $our_pods{"$_.pod"}++;
213 opendir my $dh, abs_from_top('pod/');
214 while (defined ($_ = readdir $dh)) {
215 next unless /\.pod\z/;
220 # Things we copy from won't be in perl.pod
221 # Things we copy to won't be in MANIFEST
223 my $filename = abs_from_top('MANIFEST');
224 open my $mani, '<', $filename or my_die "opening $filename failed: $!";
228 if (m!^pod/([^.]+\.pod)!i) {
230 } elsif (m!^README\.(\S+)!i) {
232 push @manireadmes, "perl$1.pod";
233 } elsif (exists $our_pods{$_}) {
239 close $mani or my_die "close MANIFEST: $!\n";
240 @manipods{@manipods} = @manipods;
241 @manireadmes{@manireadmes} = @manireadmes;
242 @cpanpods{@cpanpods} = map { s/.*\///r } @cpanpods;
243 %cpanpods_short = reverse %cpanpods;
245 $filename = abs_from_top('pod/perl.pod');
246 open my $perlpod, '<', $filename or my_die "opening $filename failed: $!\n";
248 if (/^For ease of access, /../^\(If you're intending /) {
249 if (/^\s+(perl\S*)\s+\w/) {
250 push @perlpods, "$1.pod";
254 close $perlpod or my_die "close perlpod: $!\n";
255 my_die "could not find the pod listing of perl.pod\n"
257 @perlpods{@perlpods} = @perlpods;
260 foreach my $i (sort keys %disk_pods) {
261 push @inconsistent, "$0: $i exists but is unknown by buildtoc\n"
262 unless $our_pods{$i};
263 push @inconsistent, "$0: $i exists but is unknown by ../MANIFEST\n"
264 if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i} && !$cpanpods{$i};
265 push @inconsistent, "$0: $i exists but is unknown by perl.pod\n"
266 if !$perlpods{$i} && !exists $Copies{$i} && !$cpanpods{$i} && !$ignoredpods{$i};
269 foreach my $path (values %Build) {
270 (undef, undef, my $file) = File::Spec->splitpath($path);
274 foreach my $i (sort keys %our_pods) {
275 push @inconsistent, "$0: $i is known by buildtoc but does not exist\n"
276 unless $disk_pods{$i} or $BuildFiles{$i};
278 foreach my $i (sort keys %manipods) {
279 push @inconsistent, "$0: $i is known by ../MANIFEST but does not exist\n"
280 unless $disk_pods{$i};
281 push @inconsistent, "$0: $i is known by ../MANIFEST but is marked as generated\n"
284 foreach my $i (sort keys %perlpods) {
285 push @inconsistent, "$0: $i is known by perl.pod but does not exist\n"
286 unless $disk_pods{$i} or $BuildFiles{$i} or $cpanpods_short{$i};
290 printf "1..%d\n", 1 + scalar keys %Build;
298 warn @inconsistent if @inconsistent;
302 # Find all the modules
305 find \&getpods => abs_from_top('lib/');
309 my $file = $File::Find::name;
310 return if $file =~ qr!/lib/Pod/Functions.pm\z!; # Used only by pod itself
311 return if $file =~ m!(?:^|/)t/!;
312 return if $file =~ m!lib/Attribute/Handlers/demo/!;
313 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
314 return if $file =~ m!lib/Math/BigInt/t/!;
315 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
316 return if $file =~ m!XS/(?:APItest|Typemap)!;
318 return if $pod =~ s/pm$/pod/ && -e $pod;
319 unless (open my $f, '<', $_) {
320 warn "$0: bogus <$file>: $!";
321 system "ls", "-l", $file;
325 while ($line = <$f>) {
326 if ($line =~ /^=head1\s+NAME\b/) {
327 push @modpods, $file;
331 warn "$0: NOTE: cannot find '=head1 NAME' in:\n $file\n" unless $Quiet;
336 my_die "Can't find any pods!\n" unless @modpods;
341 $name =~ s/\.p(m|od)$//;
342 $name =~ s-.*?/lib/--;
344 next if $done{$name}++;
346 if ($name =~ /^[a-z]/) {
347 $Pragmata{$name} = $_;
349 $Modules{$name} = $_;
354 # OK. Now a lot of ancillary function definitions follow
355 # Main program returns at "Do stuff"
360 my $filename = shift;
362 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
364 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
365 # This file is autogenerated by buildtoc from all the other pods.
366 # Edit those files and run buildtoc --build-toc to effect changes.
370 perltoc - perl documentation table of contents
374 This page provides a brief table of contents for the rest of the Perl
375 documentation set. It is meant to be scanned quickly or grepped
376 through to locate the proper section you're looking for.
378 =head1 BASIC DOCUMENTATION
383 # All the things in the master list that happen to be pod filenames
384 foreach (grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master) {
385 podset($_->[1], abs_from_top($_->[2]));
389 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
393 =head1 PRAGMA DOCUMENTATION
397 foreach (sort keys %Pragmata) {
398 podset($_, $Pragmata{$_});
401 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
405 =head1 MODULE DOCUMENTATION
409 foreach (sort keys %Modules) {
410 podset($_, $Modules{$_});
416 =head1 AUXILIARY DOCUMENTATION
418 Here should be listed all the extra programs' documentation, but they
419 don't all have manual pages yet:
425 $_ .= join "\n", map {"\t=item $_\n"} sort keys %Aux;
432 Larry Wall <F<larry\@wall.org>>, with the help of oodles
441 $OUT =~ s/\n\s+\n/\n\n/gs;
442 $OUT =~ s/\n{3,}/\n\n/g;
444 $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
449 # Below are all the auxiliary routines for generating perltoc.pod
451 my ($inhead1, $inhead2, $initem);
454 my ($pod, $file) = @_;
458 open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
462 if (s/^=head1 (NAME)\s*/=head2 /) {
464 $OUT .= "\n\n=head2 ";
466 # Remove svn keyword expansions from the Perl FAQ
467 s/ \(\$Revision: \d+ \$\)//g;
468 if ( /^\s*\Q$pod\E\b/ ) {
469 s/$pod\.pm/$pod/; # '.pm' in NAME !?
474 elsif (s/^=head1 (.*)/=item $1/) {
476 $OUT .= "=over 4\n\n" unless $inhead1;
480 elsif (s/^=head2 (.*)/=item $1/) {
482 $OUT .= "=over 4\n\n" unless $inhead2;
486 elsif (s/^=item ([^=].*)/$1/) {
487 next if $pod eq 'perldiag';
488 s/^\s*\*\s*$// && next;
493 next if $pod eq 'perlmodlib' && /^ftp:/;
494 $OUT .= ", " if $initem;
500 unhead1() if /^=cut\s*\n/;
510 $OUT .= "\n\n=back\n\n";
518 $OUT .= "\n\n=back\n\n";
530 # End of original buildtoc. From here on are routines to generate new sections
531 # for and inplace edit other files
533 sub generate_perlpod {
538 next if $flags->{aux};
539 next if $flags->{perlpod_omit};
543 push @output, "=head2 $_->[1]\n";
546 my $start = " " x (4 + $flags->{indent}) . $_->[4];
547 $maxlength = length $start if length ($start) > $maxlength;
548 push @output, [$start, $_->[3]];
553 my_die "Illegal length " . scalar @$_;
556 # want at least 2 spaces padding
558 $maxlength = ($maxlength + 3) & ~3;
559 # sprintf gives $1.....$2 where ... are spaces:
560 return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
565 sub generate_manifest {
566 # Annoyingly, unexpand doesn't consider it good form to replace a single
567 # space before a tab with a tab
568 # Annoyingly (2) it returns read only values.
569 my @temp = unexpand (map {sprintf "%-32s%s", @$_} @_);
570 map {s/ \t/\t\t/g; $_} @temp;
572 sub generate_manifest_pod {
573 generate_manifest map {["pod/$_.pod", $Pods{$_}]}
575 !$Copies{"$_.pod"} && !$Generated{"$_.pod"} && !-e "$_.pod"
578 sub generate_manifest_readme {
579 generate_manifest sort {$a->[0] cmp $b->[0]}
580 ["README.vms", "Notes about installing the VMS port"],
581 map {["README.$_", $Readmes{$_}]} keys %Readmes;
584 sub generate_roffitall {
585 (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
587 map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
589 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
591 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
595 sub generate_nmake_1 {
596 # XXX Fix this with File::Spec
597 (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
599 (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
602 # This doesn't have a trailing newline
603 sub generate_nmake_2 {
604 # Spot the special case
605 local $Text::Wrap::columns = 76;
606 my $line = wrap ("\t ", "\t ",
607 join " ", sort keys %Copies, keys %Generated,
608 map {"perl$_.pod"} keys %Readmes);
614 sub generate_pod_mak {
615 my $variable = shift;
617 my $line = "\U$variable = " . join "\t\\\n\t",
618 map {"$_.$variable"} sort grep { $_ !~ m{/} } keys %Pods;
620 $line =~ s/.*perltoc.html.*\n//m;
624 sub verify_contiguous {
625 my ($name, $content, $what) = @_;
626 my $sections = () = $content =~ m/\0+/g;
627 croak("$0: $name contains no $what") if $sections < 1;
628 croak("$0: $name contains discontiguous $what") if $sections > 1;
632 my ($name, $prev) = @_;
634 grep {! m!^pod/[^.]+\.pod.*!}
635 grep {! m!^README\.(\S+)! || $Ignore{$1}} split "\n", $prev;
637 # Dictionary order - fold and handle non-word chars as nothing
639 sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
640 map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
642 &generate_manifest_pod(),
643 &generate_manifest_readme()), '';
647 my ($name, $makefile) = @_;
648 $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
649 verify_contiguous($name, $makefile, 'README copies');
650 # Now remove the other copies that follow
651 1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
652 $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
654 $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)}
655 {"$1\n" . &generate_nmake_2."\n\t$2"}se;
659 # shut up used only once warning
660 *do_dmake = *do_dmake = \&do_nmake;
663 my ($name, $pod) = @_;
665 unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
666 (?:\s+[a-z]{4,}.*\n # fooo
667 |=head.*\n # =head foo
671 {$1 . join "", &generate_perlpod}mxe) {
672 my_die "Failed to insert amendments in do_perlpod";
678 my ($name, $body) = @_;
679 foreach my $variable (qw(pod man html tex)) {
680 my_die "could not find $variable in $name"
681 unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
682 {"\n" . generate_pod_mak ($variable)}se;
688 my ($name, $makefile) = @_;
690 # Looking for the macro defining the current perldelta:
691 #PERLDELTA_CURRENT = [.pod]perl5139delta.pod
693 $makefile =~ s/\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n
695 verify_contiguous($name, $makefile, 'current perldelta macro');
696 $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$delta_target", ''/se;
702 my ($name, $makefile_SH) = @_;
704 $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
705 {join ' ', $1, map "pod/$_",
706 sort keys %Copies, grep {!/perltoc/} keys %Generated
709 # pod/perl511delta.pod: pod/perldelta.pod
710 # cd pod && $(LNS) perldelta.pod perl511delta.pod
713 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
714 \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
717 verify_contiguous($name, $makefile_SH, 'copy rules');
719 my @copy_rules = map "
720 pod/$_: pod/$Copies{$_}
721 \$(LNS) $Copies{$_} pod/$_
724 $makefile_SH =~ s/\0+/join '', @copy_rules/se;
732 while (my ($target, $name) = each %Targets) {
733 print "Working on target $target\n" if $Verbose;
734 next unless $Build{$target};
737 print "Now processing $name\n" if $Verbose;
738 if ($target ne "toc") {
740 open my $thing, '<', $name or my_die "Can't open $name: $!";
743 my_die "$name contains NUL bytes" if $orig =~ /\0/;
748 &{"do_$target"}($target, $orig);
754 printf "ok %d # $name is up to date\n", $built + 1;
756 print "Was not modified\n";
760 printf "not ok %d # $name is up to date\n", $built + 1;
763 $mode = (stat $name)[2] // my_die "Can't stat $name: $!";
764 rename $name, "$name.old" or my_die "Can't rename $name to $name.old: $!";
767 open my $thing, '>', $name or my_die "Can't open $name for writing: $!";
769 print $thing $new or my_die "print to $name failed: $!";
770 close $thing or my_die "close $name failed: $!";
772 chmod $mode & 0777, $name or my_die "can't chmod $mode $name: $!";
776 warn "$0: was not instructed to build anything\n" unless $built || $Test;