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