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