This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In buildtoc, refactor the code that reads pod.lst, MANIFEST and perl.pod
[perl5.git] / pod / buildtoc
1 #!/usr/bin/perl -w
2
3 use strict;
4 use vars qw(%Build %Targets %Pragmata %Modules $Verbose $Quiet $Test);
5 use File::Spec;
6 use File::Find;
7 use FindBin;
8 use Text::Tabs;
9 use Text::Wrap;
10 use Getopt::Long;
11 use Carp;
12
13 no locale;
14 require 5.010;
15
16 # Assumption is that we're either already being run from the top level (*nix,
17 # VMS), or have absolute paths in @INC (Win32, pod/Makefile)
18 {
19   my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir);
20   chdir $Top or die "Can't chdir to $Top: $!";
21 }
22
23 # make it clearer when we haven't run to completion, as we can be quite
24 # noisy when things are working ok
25
26 sub my_die {
27     print STDERR "$0: ", @_;
28     print STDERR "\n" unless $_[-1] =~ /\n\z/;
29     print STDERR "ABORTED\n";
30     exit 255;
31 }
32
33 sub open_or_die {
34     my $filename = shift;
35     open my $fh, '<', $filename or my_die "Can't open $filename: $!";
36     return $fh;
37 }
38
39 # Generate any/all of these files
40 # --verbose gives slightly more output
41 # --quiet suppresses routine warnings
42 # --build-all tries to build everything
43 # --build-foo updates foo as follows
44 # --showfiles shows the files to be changed
45 # --test exit if perl.pod, pod.lst, MANIFEST are consistent, and regenerated
46 #   files are up to date, die otherwise.
47
48 %Targets
49   = (
50      toc => 'pod/perltoc.pod',
51      manifest => 'MANIFEST',
52      perlpod => 'pod/perl.pod',
53      vms => 'vms/descrip_mms.template',
54      nmake => 'win32/Makefile',
55      dmake => 'win32/makefile.mk',
56      podmak => 'win32/pod.mak',
57      # plan9 =>  'plan9/mkfile'),
58      unix => 'Makefile.SH',
59      # TODO: add roffitall
60     );
61
62 # process command-line switches
63
64 {
65   my @files = keys %Targets;
66   my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
67   my $showfiles;
68   my %build_these;
69   die <<__USAGE__
70 $0: Usage: $0 [--verbose] [--showfiles] $filesopts
71 __USAGE__
72   unless @ARGV
73         && GetOptions (verbose => \$Verbose,
74                        quiet => \$Quiet,
75                        showfiles => \$showfiles,
76                        test => \$Test,
77                        map {+"build-$_", \$build_these{$_}} @files, 'all');
78   if ($build_these{all}) {
79     %Build = %Targets;
80   } else {
81     while (my ($file, $want) = each %build_these) {
82       $Build{$file} = $Targets{$file} if $want;
83     }
84   }
85   if ($showfiles) {
86       print join(" ", sort { lc $a cmp lc $b } values %Build), "\n";
87       exit(0);
88   }
89 }
90
91 if ($Verbose) {
92   print "I will be building $_\n" foreach keys %Build;
93 }
94
95 sub get_pod_metadata {
96     my %BuildFiles;
97
98     foreach my $path (@_) {
99         $path =~ m!([^/]+)$!;
100         ++$BuildFiles{$1};
101     }
102
103     my %state =
104         (
105          # Don't copy these top level READMEs
106          ignore =>
107          {
108           micro => 1,
109           # vms => 1,
110          },
111      );
112
113     my $source = 'perldelta.pod';
114     my $filename = "pod/$source";
115     my $fh = open_or_die($filename);
116     my $contents = do {local $/; <$fh>};
117     my @want =
118         $contents =~ /perldelta - what is new for perl v5\.(\d+)\.(\d+)\n/;
119     die "Can't extract version from $filename" unless @want;
120     $state{delta_target} = "perl5$want[0]$want[1]delta.pod";
121
122     # This way round so that keys can act as a MANIFEST skip list
123     # Targets will always be in the pod directory. Currently we can only cope
124     # with sources being in the same directory.
125     $state{copies}{$state{delta_target}} = $source;
126
127
128     # process pod.lst
129     my %Readmepods;
130     my $master = open_or_die('pod.lst');
131
132     foreach (<$master>) {
133         next if /^\#/;
134
135         # At least one upper case letter somewhere in the first group
136         if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
137             # it's a heading
138             my $flags = $1;
139             $flags =~ tr/h//d;
140             my %flags = (header => 1);
141             $flags{toc_omit} = 1 if $flags =~ tr/o//d;
142             $flags{aux} = 1 if $flags =~ tr/a//d;
143             my_die "Unknown flag found in heading line: $_" if length $flags;
144
145             push @{$state{master}}, [\%flags, $2];
146         } elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
147             # it's a section
148             my ($flags, $podname, $desc) = ($1, $2, $3);
149             my $filename = "${podname}.pod";
150             $filename = "pod/${filename}" if $filename !~ m{/};
151
152             my %flags = (indent => 0);
153             $flags{indent} = $1 if $flags =~ s/(\d+)//;
154             $flags{toc_omit} = 1 if $flags =~ tr/o//d;
155             $flags{aux} = 1 if $flags =~ tr/a//d;
156             $flags{perlpod_omit} = "$podname.pod" eq $state{delta_target};
157
158             $state{generated}{"$podname.pod"}++ if $flags =~ tr/g//d;
159
160             if ($flags =~ tr/r//d) {
161                 my $readme = $podname;
162                 $readme =~ s/^perl//;
163                 $Readmepods{$podname} = $state{readmes}{$readme} = $desc;
164                 $flags{readme} = 1;
165             } elsif ($flags{aux}) {
166                 $state{aux}{$podname} = $desc;
167             } else {
168                 $state{pods}{$podname} = $desc;
169             }
170             my_die "Unknown flag found in section line: $_" if length $flags;
171             my $shortname = $podname =~ s{.*/}{}r;
172             push @{$state{master}},
173                 [\%flags, $podname, $filename, $desc, $shortname];
174         } elsif (/^$/) {
175             push @{$state{master}}, undef;
176         } else {
177             my_die "Malformed line: $_" if $1 =~ tr/A-Z//;
178         }
179     }
180     close $master or my_die "close pod.lst: $!";
181
182     # Sanity cross check
183
184     my (%disk_pods, @disk_pods);
185     my (@manipods, %manipods);
186     my (@manireadmes, %manireadmes);
187     my (@perlpods, %perlpods);
188     my (@cpanpods, %cpanpods, %cpanpods_short);
189     my (%our_pods);
190
191     # These are stub files for deleted documents. We don't want them to show up
192     # in perl.pod, they just exist so that if someone types "perldoc perltoot"
193     # they get some sort of pointer to the new docs.
194     my %ignoredpods
195         = map { ( "$_.pod" => 1 ) } qw( perlboot perlbot perltooc perltoot );
196
197     # Convert these to a list of filenames.
198     foreach (keys %{$state{pods}}, keys %Readmepods) {
199         $our_pods{"$_.pod"}++;
200     }
201
202     opendir my $dh, 'pod';
203     while (defined ($_ = readdir $dh)) {
204         next unless /\.pod\z/;
205         push @disk_pods, $_;
206         ++$disk_pods{$_};
207     }
208
209     # Things we copy from won't be in perl.pod
210     # Things we copy to won't be in MANIFEST
211
212     my $mani = open_or_die('MANIFEST');
213     while (<$mani>) {
214         chomp;
215         s/\s+.*$//;
216         if (m!^pod/([^.]+\.pod)!i) {
217             push @manipods, $1;
218         } elsif (m!^README\.(\S+)!i) {
219             next if $state{ignore}{$1};
220             push @manireadmes, "perl$1.pod";
221         } elsif (exists $our_pods{$_}) {
222             push @cpanpods, $_;
223             $disk_pods{$_}++
224                 if -e $_;
225         }
226     }
227     close $mani or my_die "close MANIFEST: $!\n";
228
229     @manipods{@manipods} = @manipods;
230     @manireadmes{@manireadmes} = @manireadmes;
231     @cpanpods{@cpanpods} = map { s/.*\///r } @cpanpods;
232     %cpanpods_short = reverse %cpanpods;
233
234     my $perlpod = open_or_die('pod/perl.pod');
235     while (<$perlpod>) {
236         if (/^For ease of access, /../^\(If you're intending /) {
237             if (/^\s+(perl\S*)\s+\w/) {
238                 push @perlpods, "$1.pod";
239             }
240         }
241     }
242     close $perlpod or my_die "close perlpod: $!\n";
243     my_die "could not find the pod listing of perl.pod\n"
244         unless @perlpods;
245     @perlpods{@perlpods} = @perlpods;
246
247     my @inconsistent;
248     foreach my $i (sort keys %disk_pods) {
249         push @inconsistent, "$0: $i exists but is unknown by buildtoc\n"
250             unless $our_pods{$i};
251         push @inconsistent, "$0: $i exists but is unknown by MANIFEST\n"
252             if !$manipods{$i} && !$manireadmes{$i} && !$state{copies}{$i}
253                 && !$state{generated}{$i} && !$cpanpods{$i};
254         push @inconsistent, "$0: $i exists but is unknown by perl.pod\n"
255             if !$perlpods{$i} && !exists $state{copies}{$i} && !$cpanpods{$i} && !$ignoredpods{$i};
256     }
257     foreach my $i (sort keys %our_pods) {
258         push @inconsistent, "$0: $i is known by buildtoc but does not exist\n"
259             unless $disk_pods{$i} or $BuildFiles{$i};
260     }
261     foreach my $i (sort keys %manipods) {
262         push @inconsistent, "$0: $i is known by MANIFEST but does not exist\n"
263             unless $disk_pods{$i};
264         push @inconsistent, "$0: $i is known by MANIFEST but is marked as generated\n"
265             if $state{generated}{$i};
266     }
267     foreach my $i (sort keys %perlpods) {
268         push @inconsistent, "$0: $i is known by perl.pod but does not exist\n"
269             unless $disk_pods{$i} or $BuildFiles{$i} or $cpanpods_short{$i};
270     }
271     $state{inconsistent} = \@inconsistent;
272     return \%state;
273 }
274
275 my $state = get_pod_metadata(values %Build);
276
277 if ($Test) {
278     delete $Build{toc};
279     printf "1..%d\n", 1 + scalar keys %Build;
280     if (@{$state->{inconsistent}}) {
281         print "not ok 1\n";
282         die @{$state->{inconsistent}};
283     }
284     print "ok 1\n";
285 }
286 else {
287     warn @{$state->{inconsistent}} if @{$state->{inconsistent}};
288 }
289
290
291 # Find all the modules
292 if ($Build{toc}) {
293   my @modpods;
294   find \&getpods => 'lib';
295
296   sub getpods {
297     if (/\.p(od|m)$/) {
298       my $file = $File::Find::name;
299       return if $file =~ qr!/lib/Pod/Functions.pm\z!; # Used only by pod itself
300       return if $file =~ m!(?:^|/)t/!;
301       return if $file =~ m!lib/Attribute/Handlers/demo/!;
302       return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
303       return if $file =~ m!lib/Math/BigInt/t/!;
304       return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
305       return if $file =~ m!XS/(?:APItest|Typemap)!;
306       my $pod = $file;
307       return if $pod =~ s/pm$/pod/ && -e $pod;
308       unless (open my $f, '<', $_) {
309         warn "$0: bogus <$file>: $!";
310         system "ls", "-l", $file;
311       }
312       else {
313         my $line;
314         while ($line = <$f>) {
315           if ($line =~ /^=head1\s+NAME\b/) {
316             push @modpods, $file;
317             return;
318           }
319         }
320         warn "$0: NOTE: cannot find '=head1 NAME' in:\n  $file\n" unless $Quiet;
321       }
322     }
323   }
324
325   my_die "Can't find any pods!\n" unless @modpods;
326
327   my %done;
328   for (@modpods) {
329     my $name = $_;
330     $name =~ s/\.p(m|od)$//;
331     $name =~ s-.*?/lib/--;
332     $name =~ s-/-::-g;
333     next if $done{$name}++;
334
335     if ($name =~ /^[a-z]/) {
336       $Pragmata{$name} = $_;
337     } else {
338       $Modules{$name} = $_;
339     }
340   }
341 }
342
343 # OK. Now a lot of ancillary function definitions follow
344 # Main program returns at "Do stuff"
345
346 my $OUT;
347
348 sub do_toc {
349   my $filename = shift;
350
351   ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
352
353         # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
354         # This file is autogenerated by buildtoc from all the other pods.
355         # Edit those files and run buildtoc --build-toc to effect changes.
356
357         =head1 NAME
358
359         perltoc - perl documentation table of contents
360
361         =head1 DESCRIPTION
362
363         This page provides a brief table of contents for the rest of the Perl
364         documentation set.  It is meant to be scanned quickly or grepped
365         through to locate the proper section you're looking for.
366
367         =head1 BASIC DOCUMENTATION
368
369 EOPOD2B
370 #' make emacs happy
371
372   # All the things in the master list that happen to be pod filenames
373   foreach (grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @{$state->{master}}) {
374     podset(@$_);
375   }
376
377
378   ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
379
380
381
382         =head1 PRAGMA DOCUMENTATION
383
384 EOPOD2B
385
386   foreach (sort keys %Pragmata) {
387     podset($_, $Pragmata{$_});
388   }
389
390   ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
391
392
393
394         =head1 MODULE DOCUMENTATION
395
396 EOPOD2B
397
398   foreach (sort keys %Modules) {
399     podset($_, $Modules{$_});
400   }
401
402   $_= <<"EOPOD2B";
403
404
405         =head1 AUXILIARY DOCUMENTATION
406
407         Here should be listed all the extra programs' documentation, but they
408         don't all have manual pages yet:
409
410         =over 4
411
412 EOPOD2B
413
414   $_ .=  join "\n", map {"\t=item $_\n"} sort keys %{$state->{aux}};
415   $_ .= <<"EOPOD2B" ;
416
417         =back
418
419         =head1 AUTHOR
420
421         Larry Wall <F<larry\@wall.org>>, with the help of oodles
422         of other folks.
423
424
425 EOPOD2B
426
427   s/^\t//gm;
428   $OUT .= "$_\n";
429
430   $OUT =~ s/\n\s+\n/\n\n/gs;
431   $OUT =~ s/\n{3,}/\n\n/g;
432
433   $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
434
435   return $OUT;
436 }
437
438 # Below are all the auxiliary routines for generating perltoc.pod
439
440 my ($inhead1, $inhead2, $initem);
441
442 sub podset {
443     my ($pod, $file) = @_;
444
445     local $/ = '';
446
447     open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
448
449     while(<$fh>) {
450         tr/\015//d;
451         if (s/^=head1 (NAME)\s*/=head2 /) {
452             unhead1();
453             $OUT .= "\n\n=head2 ";
454             $_ = <$fh>;
455             # Remove svn keyword expansions from the Perl FAQ
456             s/ \(\$Revision: \d+ \$\)//g;
457             if ( /^\s*\Q$pod\E\b/ ) {
458                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
459             } else {
460                 s/^/$pod, /;
461             }
462         }
463         elsif (s/^=head1 (.*)/=item $1/) {
464             unhead2();
465             $OUT .= "=over 4\n\n" unless $inhead1;
466             $inhead1 = 1;
467             $_ .= "\n";
468         }
469         elsif (s/^=head2 (.*)/=item $1/) {
470             unitem();
471             $OUT .= "=over 4\n\n" unless $inhead2;
472             $inhead2 = 1;
473             $_ .= "\n";
474         }
475         elsif (s/^=item ([^=].*)/$1/) {
476             next if $pod eq 'perldiag';
477             s/^\s*\*\s*$// && next;
478             s/^\s*\*\s*//;
479             s/\n/ /g;
480             s/\s+$//;
481             next if /^[\d.]+$/;
482             next if $pod eq 'perlmodlib' && /^ftp:/;
483             $OUT .= ", " if $initem;
484             $initem = 1;
485             s/\.$//;
486             s/^-X\b/-I<X>/;
487         }
488         else {
489             unhead1() if /^=cut\s*\n/;
490             next;
491         }
492         $OUT .= $_;
493     }
494 }
495
496 sub unhead1 {
497     unhead2();
498     if ($inhead1) {
499         $OUT .= "\n\n=back\n\n";
500     }
501     $inhead1 = 0;
502 }
503
504 sub unhead2 {
505     unitem();
506     if ($inhead2) {
507         $OUT .= "\n\n=back\n\n";
508     }
509     $inhead2 = 0;
510 }
511
512 sub unitem {
513     if ($initem) {
514         $OUT .= "\n\n";
515     }
516     $initem = 0;
517 }
518
519 # End of original buildtoc. From here on are routines to generate new sections
520 # for and inplace edit other files
521
522 sub generate_perlpod {
523   my @output;
524   my $maxlength = 0;
525   foreach (@{$state->{master}}) {
526     my $flags = $_->[0];
527     next if $flags->{aux};
528     next if $flags->{perlpod_omit};
529
530     if (@$_ == 2) {
531       # Heading
532       push @output, "=head2 $_->[1]\n";
533     } elsif (@$_ == 5) {
534       # Section
535       my $start = " " x (4 + $flags->{indent}) . $_->[4];
536       $maxlength = length $start if length ($start) > $maxlength;
537       push @output, [$start, $_->[3]];
538     } elsif (@$_ == 0) {
539       # blank line
540       push @output, "\n";
541     } else {
542       my_die "Illegal length " . scalar @$_;
543     }
544   }
545   # want at least 2 spaces padding
546   $maxlength += 2;
547   $maxlength = ($maxlength + 3) & ~3;
548   # sprintf gives $1.....$2 where ... are spaces:
549   return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
550                    @output);
551 }
552
553
554 sub generate_manifest {
555   # Annoyingly, unexpand doesn't consider it good form to replace a single
556   # space before a tab with a tab
557   # Annoyingly (2) it returns read only values.
558   my @temp = unexpand (map {sprintf "%-32s%s", @$_} @_);
559   map {s/ \t/\t\t/g; $_} @temp;
560 }
561 sub generate_manifest_pod {
562   generate_manifest map {["pod/$_.pod", $state->{pods}{$_}]}
563     sort grep {
564         !$state->{copies}{"$_.pod"} && !$state->{generated}{"$_.pod"} && !-e "$_.pod"
565     } keys %{$state->{pods}};
566 }
567 sub generate_manifest_readme {
568   generate_manifest sort {$a->[0] cmp $b->[0]}
569     ["README.vms", "Notes about installing the VMS port"],
570       map {["README.$_", $state->{readmes}{$_}]} keys %{$state->{readmes}};
571 }
572
573 sub generate_roffitall {
574   (map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{pods}}),
575    "\t\t\\",
576    map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{aux}}),
577    "\t\t\\",
578    map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
579    "\t\t\\",
580    map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
581   )
582 }
583
584 sub generate_nmake_1 {
585   # XXX Fix this with File::Spec
586   (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
587     sort keys %{$state->{readmes}}),
588       (map {"\tcopy ..\\pod\\$state->{copies}{$_} ..\\pod\\$_\n"} sort keys %{$state->{copies}});
589 }
590
591 # This doesn't have a trailing newline
592 sub generate_nmake_2 {
593   # Spot the special case
594   local $Text::Wrap::columns = 76;
595   my $line = wrap ("\t    ", "\t    ",
596                    join " ", sort keys %{$state->{copies}}, keys %{$state->{generated}},
597                                   map {"perl$_.pod"} keys %{$state->{readmes}});
598   $line =~ s/$/ \\/mg;
599   $line =~ s/ \\$//;
600   $line;
601 }
602
603 sub generate_pod_mak {
604   my $variable = shift;
605   my @lines;
606   my $line = "\U$variable = " . join "\t\\\n\t",
607     map {"$_.$variable"} sort grep { $_ !~ m{/} } keys %{$state->{pods}};
608   # Special case
609   $line =~ s/.*perltoc.html.*\n//m;
610   $line;
611 }
612
613 sub verify_contiguous {
614   my ($name, $content, $what) = @_;
615   my $sections = () = $content =~ m/\0+/g;
616   croak("$0: $name contains no $what") if $sections < 1;
617   croak("$0: $name contains discontiguous $what") if $sections > 1;
618 }
619
620 sub do_manifest {
621   my ($name, $prev) = @_;
622   my @manifest =
623     grep {! m!^pod/[^.]+\.pod.*!}
624       grep {! m!^README\.(\S+)! || $state->{ignore}{$1}} split "\n", $prev;
625   join "\n", (
626               # Dictionary order - fold and handle non-word chars as nothing
627               map  { $_->[0] }
628               sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
629               map  { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
630               @manifest,
631               &generate_manifest_pod(),
632               &generate_manifest_readme()), '';
633 }
634
635 sub do_nmake {
636   my ($name, $makefile) = @_;
637   $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
638   verify_contiguous($name, $makefile, 'README copies');
639   # Now remove the other copies that follow
640   1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
641   $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
642
643   $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)}
644     {"$1\n" . &generate_nmake_2."\n\t$2"}se;
645   $makefile;
646 }
647
648 # shut up used only once warning
649 *do_dmake = *do_dmake = \&do_nmake;
650
651 sub do_perlpod {
652   my ($name, $pod) = @_;
653
654   unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
655                     (?:\s+[a-z]{4,}.*\n #   fooo
656                     |=head.*\n          # =head foo
657                     |\s*\n              # blank line
658                    )+
659                   }
660           {$1 . join "", &generate_perlpod}mxe) {
661     my_die "Failed to insert amendments in do_perlpod";
662   }
663   $pod;
664 }
665
666 sub do_podmak {
667   my ($name, $body) = @_;
668   foreach my $variable (qw(pod man html tex)) {
669     my_die "could not find $variable in $name"
670       unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
671         {"\n" . generate_pod_mak ($variable)}se;
672   }
673   $body;
674 }
675
676 sub do_vms {
677   my ($name, $makefile) = @_;
678
679 # Looking for the macro defining the current perldelta:
680 #PERLDELTA_CURRENT = [.pod]perl5139delta.pod
681
682   $makefile =~ s/\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n
683                     /\0/sx;
684   verify_contiguous($name, $makefile, 'current perldelta macro');
685   $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$state->{delta_target}", ''/se;
686
687   $makefile;
688 }
689
690 sub do_unix {
691   my ($name, $makefile_SH) = @_;
692
693   $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
694                    {join ' ', $1, map "pod/$_",
695                         sort keys %{$state->{copies}}, grep {!/perltoc/} keys %{$state->{generated}}
696                     }mge;
697
698 # pod/perl511delta.pod: pod/perldelta.pod
699 #       cd pod && $(LNS) perldelta.pod perl511delta.pod
700
701   $makefile_SH =~ s!(
702 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
703         \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
704 )+!\0!gm;
705
706   verify_contiguous($name, $makefile_SH, 'copy rules');
707
708   my @copy_rules = map "
709 pod/$_: pod/$state->{copies}{$_}
710         \$(LNS) $state->{copies}{$_} pod/$_
711 ", keys %{$state->{copies}};
712
713   $makefile_SH =~ s/\0+/join '', @copy_rules/se;
714   $makefile_SH;
715
716 }
717
718 # Do stuff
719
720 my $built;
721 while (my ($target, $name) = each %Targets) {
722   print "Working on target $target\n" if $Verbose;
723   next unless $Build{$target};
724   $built++;
725   my ($orig, $mode);
726   print "Now processing $name\n" if $Verbose;
727   if ($target ne "toc") {
728     local $/;
729     my $thing = open_or_die($name);
730     binmode $thing;
731     $orig = <$thing>;
732     my_die "$name contains NUL bytes" if $orig =~ /\0/;
733   }
734
735   my $new = do {
736     no strict 'refs';
737     &{"do_$target"}($target, $orig);
738   };
739
740   if (defined $orig) {
741     if ($new eq $orig) {
742       if ($Test) {
743         printf "ok %d # $name is up to date\n", $built + 1;
744       } elsif ($Verbose) {
745         print "Was not modified\n";
746       }
747       next;
748     } elsif ($Test) {
749       printf "not ok %d # $name is up to date\n", $built + 1;
750       next;
751     }
752     $mode = (stat $name)[2] // my_die "Can't stat $name: $!";
753     rename $name, "$name.old" or my_die "Can't rename $name to $name.old: $!";
754   }
755
756   open my $thing, '>', $name or my_die "Can't open $name for writing: $!";
757   binmode $thing;
758   print $thing $new or my_die "print to $name failed: $!";
759   close $thing or my_die "close $name failed: $!";
760   if (defined $mode) {
761     chmod $mode & 0777, $name or my_die "can't chmod $mode $name: $!";
762   }
763 }
764
765 warn "$0: was not instructed to build anything\n" unless $built || $Test;