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