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