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