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