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