Create perldelta for 5.14.3
[perl.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   foreach my $path (values %Build) {
239     (undef, undef, my $file) = File::Spec->splitpath($path);
240     ++$BuildFiles{$file}
241   }
242
243   foreach my $i (sort keys %our_pods) {
244     push @inconsistent, "$0: $i is known by buildtoc but does not exist\n"
245       unless $disk_pods{$i} or $BuildFiles{$i};
246   }
247   foreach my $i (sort keys %manipods) {
248     push @inconsistent, "$0: $i is known by ../MANIFEST but does not exist\n"
249       unless $disk_pods{$i};
250     push @inconsistent, "$0: $i is known by ../MANIFEST but is marked as generated\n"
251       if $Generated{$i};
252   }
253   foreach my $i (sort keys %perlpods) {
254     push @inconsistent, "$0: $i is known by perl.pod but does not exist\n"
255       unless $disk_pods{$i} or $BuildFiles{$i};
256   }
257   if ($Test) {
258     delete $Build{toc};
259     printf "1..%d\n", 1 + scalar keys %Build;
260     if (@inconsistent) {
261       print "not ok 1\n";
262       die @inconsistent
263     }
264     print "ok 1\n";
265   }
266   else {
267     warn @inconsistent if @inconsistent;
268   }
269 }
270
271 # Find all the modules
272 if ($Build{toc}) {
273   my @modpods;
274   find \&getpods => abs_from_top('lib/');
275
276   sub getpods {
277     if (/\.p(od|m)$/) {
278       my $file = $File::Find::name;
279       return if $file =~ qr!/lib/Pod/Functions.pm\z!; # Used only by pod itself
280       return if $file =~ m!(?:^|/)t/!;
281       return if $file =~ m!lib/Attribute/Handlers/demo/!;
282       return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
283       return if $file =~ m!lib/Math/BigInt/t/!;
284       return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
285       return if $file =~ m!XS/(?:APItest|Typemap)!;
286       my $pod = $file;
287       return if $pod =~ s/pm$/pod/ && -e $pod;
288       unless (open my $f, '<', $_) {
289         warn "$0: bogus <$file>: $!";
290         system "ls", "-l", $file;
291       }
292       else {
293         my $line;
294         while ($line = <$f>) {
295           if ($line =~ /^=head1\s+NAME\b/) {
296             push @modpods, $file;
297             return;
298           }
299         }
300         warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet;
301       }
302     }
303   }
304
305   die "$0: no pods" unless @modpods;
306
307   my %done;
308   for (@modpods) {
309     my $name = $_;
310     $name =~ s/\.p(m|od)$//;
311     $name =~ s-.*?/lib/--;
312     $name =~ s-/-::-g;
313     next if $done{$name}++;
314
315     if ($name =~ /^[a-z]/) {
316       $Pragmata{$name} = $_;
317     } else {
318       $Modules{$name} = $_;
319     }
320   }
321 }
322
323 # OK. Now a lot of ancillary function definitions follow
324 # Main program returns at "Do stuff"
325
326 my $OUT;
327
328 sub do_toc {
329   my $filename = shift;
330
331   ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
332
333         # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
334         # This file is autogenerated by buildtoc from all the other pods.
335         # Edit those files and run buildtoc --build-toc to effect changes.
336
337         =head1 NAME
338
339         perltoc - perl documentation table of contents
340
341         =head1 DESCRIPTION
342
343         This page provides a brief table of contents for the rest of the Perl
344         documentation set.  It is meant to be scanned quickly or grepped
345         through to locate the proper section you're looking for.
346
347         =head1 BASIC DOCUMENTATION
348
349 EOPOD2B
350 #' make emacs happy
351
352   # All the things in the master list that happen to be pod filenames
353   foreach (grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master) {
354     podset($_->[1], abs_from_top("pod/$_->[1].pod"));
355   }
356
357
358   ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
359
360
361
362         =head1 PRAGMA DOCUMENTATION
363
364 EOPOD2B
365
366   foreach (sort keys %Pragmata) {
367     podset($_, $Pragmata{$_});
368   }
369
370   ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
371
372
373
374         =head1 MODULE DOCUMENTATION
375
376 EOPOD2B
377
378   foreach (sort keys %Modules) {
379     podset($_, $Modules{$_});
380   }
381
382   $_= <<"EOPOD2B";
383
384
385         =head1 AUXILIARY DOCUMENTATION
386
387         Here should be listed all the extra programs' documentation, but they
388         don't all have manual pages yet:
389
390         =over 4
391
392 EOPOD2B
393
394   $_ .=  join "\n", map {"\t=item $_\n"} sort keys %Aux;
395   $_ .= <<"EOPOD2B" ;
396
397         =back
398
399         =head1 AUTHOR
400
401         Larry Wall <F<larry\@wall.org>>, with the help of oodles
402         of other folks.
403
404
405 EOPOD2B
406
407   s/^\t//gm;
408   $OUT .= "$_\n";
409
410   $OUT =~ s/\n\s+\n/\n\n/gs;
411   $OUT =~ s/\n{3,}/\n\n/g;
412
413   $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
414
415   return $OUT;
416 }
417
418 # Below are all the auxiliary routines for generating perltoc.pod
419
420 my ($inhead1, $inhead2, $initem);
421
422 sub podset {
423     my ($pod, $file) = @_;
424
425     local $/ = '';
426
427     open my $fh, '<', $file or die "Can't open file '$file' for $pod: $!";
428
429     while(<$fh>) {
430         tr/\015//d;
431         if (s/^=head1 (NAME)\s*/=head2 /) {
432             unhead1();
433             $OUT .= "\n\n=head2 ";
434             $_ = <$fh>;
435             # Remove svn keyword expansions from the Perl FAQ
436             s/ \(\$Revision: \d+ \$\)//g;
437             if ( /^\s*\Q$pod\E\b/ ) {
438                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
439             } else {
440                 s/^/$pod, /;
441             }
442         }
443         elsif (s/^=head1 (.*)/=item $1/) {
444             unhead2();
445             $OUT .= "=over 4\n\n" unless $inhead1;
446             $inhead1 = 1;
447             $_ .= "\n";
448         }
449         elsif (s/^=head2 (.*)/=item $1/) {
450             unitem();
451             $OUT .= "=over 4\n\n" unless $inhead2;
452             $inhead2 = 1;
453             $_ .= "\n";
454         }
455         elsif (s/^=item ([^=].*)/$1/) {
456             next if $pod eq 'perldiag';
457             s/^\s*\*\s*$// && next;
458             s/^\s*\*\s*//;
459             s/\n/ /g;
460             s/\s+$//;
461             next if /^[\d.]+$/;
462             next if $pod eq 'perlmodlib' && /^ftp:/;
463             $OUT .= ", " if $initem;
464             $initem = 1;
465             s/\.$//;
466             s/^-X\b/-I<X>/;
467         }
468         else {
469             unhead1() if /^=cut\s*\n/;
470             next;
471         }
472         $OUT .= $_;
473     }
474 }
475
476 sub unhead1 {
477     unhead2();
478     if ($inhead1) {
479         $OUT .= "\n\n=back\n\n";
480     }
481     $inhead1 = 0;
482 }
483
484 sub unhead2 {
485     unitem();
486     if ($inhead2) {
487         $OUT .= "\n\n=back\n\n";
488     }
489     $inhead2 = 0;
490 }
491
492 sub unitem {
493     if ($initem) {
494         $OUT .= "\n\n";
495     }
496     $initem = 0;
497 }
498
499 # End of original buildtoc. From here on are routines to generate new sections
500 # for and inplace edit other files
501
502 sub generate_perlpod {
503   my @output;
504   my $maxlength = 0;
505   foreach (@Master) {
506     my $flags = $_->[0];
507     next if $flags->{aux};
508     next if $flags->{perlpod_omit};
509
510     if (@$_ == 2) {
511       # Heading
512       push @output, "=head2 $_->[1]\n";
513     } elsif (@$_ == 3) {
514       # Section
515       my $start = " " x (4 + $flags->{indent}) . $_->[1];
516       $maxlength = length $start if length ($start) > $maxlength;
517       push @output, [$start, $_->[2]];
518     } elsif (@$_ == 0) {
519       # blank line
520       push @output, "\n";
521     } else {
522       die "$0: Illegal length " . scalar @$_;
523     }
524   }
525   # want at least 2 spaces padding
526   $maxlength += 2;
527   $maxlength = ($maxlength + 3) & ~3;
528   # sprintf gives $1.....$2 where ... are spaces:
529   return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
530                    @output);
531 }
532
533
534 sub generate_manifest {
535   # Annoyingly, unexpand doesn't consider it good form to replace a single
536   # space before a tab with a tab
537   # Annoyingly (2) it returns read only values.
538   my @temp = unexpand (map {sprintf "%-32s%s", @$_} @_);
539   map {s/ \t/\t\t/g; $_} @temp;
540 }
541 sub generate_manifest_pod {
542   generate_manifest map {["pod/$_.pod", $Pods{$_}]}
543     sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
544 }
545 sub generate_manifest_readme {
546   generate_manifest sort {$a->[0] cmp $b->[0]}
547     ["README.vms", "Notes about installing the VMS port"],
548       map {["README.$_", $Readmes{$_}]} keys %Readmes;
549 }
550
551 sub generate_roffitall {
552   (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
553    "\t\t\\",
554    map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
555    "\t\t\\",
556    map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
557    "\t\t\\",
558    map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
559   )
560 }
561
562 sub generate_descrip_mms_1 {
563   local $Text::Wrap::columns = 150;
564   my $count = 0;
565   my @lines = map {"pod" . $count++ . " = $_"}
566     split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
567                      sort keys %Pods, keys %Readmepods);
568   @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
569 }
570
571 sub generate_descrip_mms_2 {
572   map {<<"SNIP"}
573 [.lib.pods]$_.pod : [.pod]$_.pod
574         \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
575         Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
576 SNIP
577    sort keys %Pods, keys %Readmepods;
578 }
579
580 sub generate_nmake_1 {
581   # XXX Fix this with File::Spec
582   (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
583     sort keys %Readmes),
584       (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
585 }
586
587 # This doesn't have a trailing newline
588 sub generate_nmake_2 {
589   # Spot the special case
590   local $Text::Wrap::columns = 76;
591   my $line = wrap ("\t    ", "\t    ",
592                    join " ", sort keys %Copies, keys %Generated,
593                                   map {"perl$_.pod"} keys %Readmes);
594   $line =~ s/$/ \\/mg;
595   $line =~ s/ \\$//;
596   $line;
597 }
598
599 sub generate_pod_mak {
600   my $variable = shift;
601   my @lines;
602   my $line = join "\\\n", "\U$variable = ",
603     map {"\t$_.$variable\t"} sort keys %Pods;
604   # Special case
605   $line =~ s/.*perltoc.html.*\n//m;
606   $line;
607 }
608
609 sub verify_contiguous {
610   my ($name, $content, $what) = @_;
611   my $sections = () = $content =~ m/\0+/g;
612   croak("$0: $name contains no $what") if $sections < 1;
613   croak("$0: $name contains discontiguous $what") if $sections > 1;
614 }
615
616 sub do_manifest {
617   my ($name, $prev) = @_;
618   my @manifest =
619     grep {! m!^pod/[^.]+\.pod.*!}
620       grep {! m!^README\.(\S+)! || $Ignore{$1}} split "\n", $prev;
621   join "\n", (
622               # Dictionary order - fold and handle non-word chars as nothing
623               map  { $_->[0] }
624               sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
625               map  { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
626               @manifest,
627               &generate_manifest_pod(),
628               &generate_manifest_readme()), '';
629 }
630
631 sub do_nmake {
632   my ($name, $makefile) = @_;
633   $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
634   verify_contiguous($name, $makefile, 'README copies');
635   # Now remove the other copies that follow
636   1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
637   $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
638
639   $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)}
640     {"$1\n" . &generate_nmake_2."\n\t$2"}se;
641   $makefile;
642 }
643
644 # shut up used only once warning
645 *do_dmake = *do_dmake = \&do_nmake;
646
647 sub do_perlpod {
648   my ($name, $pod) = @_;
649
650   unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
651                     (?:\s+[a-z]{4,}.*\n #   fooo
652                     |=head.*\n          # =head foo
653                     |\s*\n              # blank line
654                    )+
655                   }
656           {$1 . join "", &generate_perlpod}mxe) {
657     die "$0: Failed to insert amendments in do_perlpod";
658   }
659   $pod;
660 }
661
662 sub do_podmak {
663   my ($name, $body) = @_;
664   foreach my $variable (qw(pod man html tex)) {
665     die "$0: could not find $variable in $name"
666       unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
667         {"\n" . generate_pod_mak ($variable)}se;
668   }
669   $body;
670 }
671
672 sub do_vms {
673   my ($name, $makefile) = @_;
674   $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
675   verify_contiguous($name, $makefile, 'pod assignments');
676   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
677
678   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
679
680 # Looking for the macro defining the current perldelta:
681 #PERLDELTA_CURRENT = [.pod]perl5139delta.pod
682
683   $makefile =~ s/\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n
684                     /\0/sx;
685   verify_contiguous($name, $makefile, 'current perldelta macro');
686   $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$delta_target", ''/se;
687
688 # Looking for rules like this
689 # [.lib.pods]perl.pod : [.pod]perl.pod
690 #       @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
691 #       Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
692
693   $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
694                  [^\n]+\n       # Another line
695                  [^\n]+\Q[.lib.pods]\E\n                # ends [.lib.pods]
696                     /\0/gsx;
697   verify_contiguous($name, $makefile, 'copy rules');
698   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
699
700   $makefile;
701 }
702
703 sub do_unix {
704   my ($name, $makefile_SH) = @_;
705
706   $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
707                    {join ' ', $1, map "pod/$_",
708                         sort keys %Copies, grep {!/perltoc/} keys %Generated
709                     }mge;
710
711 # pod/perl511delta.pod: pod/perldelta.pod
712 #       cd pod && $(LNS) perldelta.pod perl511delta.pod
713
714   $makefile_SH =~ s!(
715 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
716         \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
717 )+!\0!gm;
718
719   verify_contiguous($name, $makefile_SH, 'copy rules');
720
721   my @copy_rules = map "
722 pod/$_: pod/$Copies{$_}
723         \$(LNS) $Copies{$_} pod/$_
724 ", keys %Copies;
725
726   $makefile_SH =~ s/\0+/join '', @copy_rules/se;
727   $makefile_SH;
728
729 }
730
731 # Do stuff
732
733 my $built;
734 while (my ($target, $name) = each %Targets) {
735   print "Working on target $target\n" if $Verbose;
736   next unless $Build{$target};
737   $built++;
738   my ($orig, $mode);
739   print "Now processing $name\n" if $Verbose;
740   if ($target ne "toc") {
741     local $/;
742     open my $thing, '<', $name or die "Can't open $name: $!";
743     binmode $thing;
744     $orig = <$thing>;
745     die "$0: $name contains NUL bytes" if $orig =~ /\0/;
746   }
747
748   my $new = do {
749     no strict 'refs';
750     &{"do_$target"}($target, $orig);
751   };
752
753   if (defined $orig) {
754     if ($new eq $orig) {
755       if ($Test) {
756         printf "ok %d # $name is up to date\n", $built + 1;
757       } elsif ($Verbose) {
758         print "Was not modified\n";
759       }
760       next;
761     } elsif ($Test) {
762       printf "not ok %d # $name is up to date\n", $built + 1;
763       next;
764     }
765     $mode = (stat $name)[2] // die "$0: Can't stat $name: $!";
766     rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
767   }
768
769   open my $thing, '>', $name or die "$0: Can't open $name for writing: $!";
770   binmode $thing;
771   print $thing $new or die "$0: print to $name failed: $!";
772   close $thing or die "$0: close $name failed: $!";
773   if (defined $mode) {
774     chmod $mode & 0777, $name or die "$0: can't chmod $mode $name: $!";
775   }
776 }
777
778 warn "$0: was not instructed to build anything\n" unless $built || $Test;