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