This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In buildtoc, remove whitespace only lines just before output.
[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   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 sub output ($);
321
322 my $OUT;
323
324 sub output_perltoc {
325   my $filename = shift;
326
327   local $/ = '';
328
329   ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
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 && output($_);
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 && output($_);
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   output $_;
407   output "\n";                    # flush $LINE
408
409   $OUT =~ s/\n\s+\n/\n\n/gs;
410   $OUT =~ s/\n{3,}/\n\n/g;
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             output "\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                 output $_;
436             } else {
437                 s/^/$pod, /;
438                 output $_;
439             }
440             next;
441         }
442         if (s/^=head1 (.*)/=item $1/) {
443             unhead2();
444             output "=over 4\n\n" unless $inhead1;
445             $inhead1 = 1;
446             output "$_\n"; next;
447         }
448         if (s/^=head2 (.*)/=item $1/) {
449             unitem();
450             output "=over 4\n\n" unless $inhead2;
451             $inhead2 = 1;
452             output "$_\n"; next;
453         }
454         if (s/^=item ([^=].*)/$1/) {
455             next if $pod eq 'perldiag';
456             s/^\s*\*\s*$// && next;
457             s/^\s*\*\s*//;
458             s/\n/ /g;
459             s/\s+$//;
460             next if /^[\d.]+$/;
461             next if $pod eq 'perlmodlib' && /^ftp:/;
462             output ", " if $initem;
463             $initem = 1;
464             s/\.$//;
465             s/^-X\b/-I<X>/;
466             output $_; next;
467         }
468         if (s/^=cut\s*\n//) {
469             unhead1();
470             next;
471         }
472     }
473 }
474
475 sub unhead1 {
476     unhead2();
477     if ($inhead1) {
478         output "\n\n=back\n\n";
479     }
480     $inhead1 = 0;
481 }
482
483 sub unhead2 {
484     unitem();
485     if ($inhead2) {
486         output "\n\n=back\n\n";
487     }
488     $inhead2 = 0;
489 }
490
491 sub unitem {
492     if ($initem) {
493         output "\n\n";
494     }
495     $initem = 0;
496 }
497
498 my $LINE;               # what remains to be printed
499
500 sub output ($) {
501     for (split /(\n)/, shift) {
502         if ($_ eq "\n") {
503             if ($LINE) {
504                 $OUT .=  wrap('', '', $LINE);
505                 $LINE = '';
506             }
507             $OUT .= $_;
508         }
509         else {
510             $LINE .= $_;
511         }
512     }
513 }
514
515 # End of original buildtoc. From here on are routines to generate new sections
516 # for and inplace edit other files
517
518 sub generate_perlpod {
519   my @output;
520   my $maxlength = 0;
521   foreach (@Master) {
522     my $flags = $_->[0];
523     next if $flags->{aux};
524     next if $flags->{perlpod_omit};
525
526     if (@$_ == 2) {
527       # Heading
528       push @output, "=head2 $_->[1]\n";
529     } elsif (@$_ == 3) {
530       # Section
531       my $start = " " x (4 + $flags->{indent}) . $_->[1];
532       $maxlength = length $start if length ($start) > $maxlength;
533       push @output, [$start, $_->[2]];
534     } elsif (@$_ == 0) {
535       # blank line
536       push @output, "\n";
537     } else {
538       die "$0: Illegal length " . scalar @$_;
539     }
540   }
541   # want at least 2 spaces padding
542   $maxlength += 2;
543   $maxlength = ($maxlength + 3) & ~3;
544   # sprintf gives $1.....$2 where ... are spaces:
545   return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
546                    @output);
547 }
548
549
550 sub generate_manifest {
551   # Annoyingly, unexpand doesn't consider it good form to replace a single
552   # space before a tab with a tab
553   # Annoyingly (2) it returns read only values.
554   my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
555   map {s/ \t/\t\t/g; $_} @temp;
556 }
557 sub generate_manifest_pod {
558   generate_manifest map {["pod/$_.pod", $Pods{$_}]}
559     sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
560 }
561 sub generate_manifest_readme {
562   generate_manifest sort {$a->[0] cmp $b->[0]}
563     ["README.vms", "Notes about installing the VMS port"],
564       map {["README.$_", $Readmes{$_}]} keys %Readmes;
565 }
566
567 sub generate_roffitall {
568   (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
569    "\t\t\\",
570    map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
571    "\t\t\\",
572    map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
573    "\t\t\\",
574    map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
575   )
576 }
577
578 sub generate_descrip_mms_1 {
579   local $Text::Wrap::columns = 150;
580   my $count = 0;
581   my @lines = map {"pod" . $count++ . " = $_"}
582     split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
583                      sort keys %Pods, keys %Readmepods);
584   @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
585 }
586
587 sub generate_descrip_mms_2 {
588   map {<<"SNIP"}
589 [.lib.pods]$_.pod : [.pod]$_.pod
590         \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
591         Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
592 SNIP
593    sort keys %Pods, keys %Readmepods;
594 }
595
596 sub generate_descrip_mms_3 {
597   map qq{\t- If F\$Search("[.pod]$_").nes."" Then Delete/NoConfirm/Log [.pod]$_;*},
598     sort keys %Generated, keys %Copies;
599 }
600
601 sub generate_nmake_1 {
602   # XXX Fix this with File::Spec
603   (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
604     sort keys %Readmes),
605       (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
606 }
607
608 # This doesn't have a trailing newline
609 sub generate_nmake_2 {
610   # Spot the special case
611   local $Text::Wrap::columns = 76;
612   my $line = wrap ("\t    ", "\t    ",
613                    join " ", sort keys %Copies, keys %Generated,
614                                   map {"perl$_.pod"} keys %Readmes);
615   $line =~ s/$/ \\/mg;
616   $line =~ s/ \\$//;
617   $line;
618 }
619
620 sub generate_pod_mak {
621   my $variable = shift;
622   my @lines;
623   my $line = join "\\\n", "\U$variable = ",
624     map {"\t$_.$variable\t"} sort keys %Pods;
625   # Special case
626   $line =~ s/.*perltoc.html.*\n//m;
627   $line;
628 }
629
630 sub verify_contiguous {
631   my ($name, $content, $what) = @_;
632   my $sections = () = $content =~ m/\0+/g;
633   croak("$0: $name contains no $what") if $sections < 1;
634   croak("$0: $name contains discontiguous $what") if $sections > 1;
635 }
636
637 sub do_manifest {
638   my $name = shift;
639   my @manifest =
640     grep {! m!^pod/[^.]+\.pod.*\n!}
641       grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
642   # Dictionary order - fold and handle non-word chars as nothing
643   map  { $_->[0] }
644   sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
645   map  { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
646     @manifest,
647       &generate_manifest_pod(),
648         &generate_manifest_readme();
649 }
650
651 sub do_nmake {
652   my $name = shift;
653   my $makefile = join '', @_;
654   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
655   $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
656   verify_contiguous($name, $makefile, 'README copies');
657   # Now remove the other copies that follow
658   1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
659   $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
660
661   $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)}
662     {"$1\n" . &generate_nmake_2."\n\t$2"}se;
663   $makefile;
664 }
665
666 # shut up used only once warning
667 *do_dmake = *do_dmake = \&do_nmake;
668
669 sub do_perlpod {
670   my $name = shift;
671   my $pod = join '', @_;
672
673   unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
674                     (?:\s+[a-z]{4,}.*\n #   fooo
675                     |=head.*\n          # =head foo
676                     |\s*\n              # blank line
677                    )+
678                   }
679           {$1 . join "", &generate_perlpod}mxe) {
680     die "$0: Failed to insert amendments in do_perlpod";
681   }
682   $pod;
683 }
684
685 sub do_podmak {
686   my $name = shift;
687   my $body = join '', @_;
688   foreach my $variable (qw(pod man html tex)) {
689     die "$0: could not find $variable in $name"
690       unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
691         {"\n" . generate_pod_mak ($variable)}se;
692   }
693   $body;
694 }
695
696 sub do_vms {
697   my $name = shift;
698   my $makefile = join '', @_;
699   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
700   $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
701   verify_contiguous($name, $makefile, 'pod assignments');
702   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
703
704   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
705
706 # Looking for rules like this
707 # [.lib.pods]perl.pod : [.pod]perl.pod
708 #       @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
709 #       Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
710
711   $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
712                  [^\n]+\n       # Another line
713                  [^\n]+\Q[.lib.pods]\E\n                # ends [.lib.pods]
714                     /\0/gsx;
715   verify_contiguous($name, $makefile, 'copy rules');
716   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
717
718 # Looking for rules like this:
719 #       - If F$Search("[.pod]perldelta.pod").nes."" Then Delete/NoConfirm/Log [.pod]perldelta.pod;*
720   $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;
721   verify_contiguous($name, $makefile, 'delete rules');
722   $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/se;
723
724   $makefile;
725 }
726
727 sub do_unix {
728   my $name = shift;
729   my $makefile_SH = join '', @_;
730   die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
731
732   $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
733                    {join ' ', $1, map "pod/$_",
734                         sort keys %Copies, grep {!/perltoc/} keys %Generated
735                     }mge;
736
737 # pod/perl511delta.pod: pod/perldelta.pod
738 #       cd pod && $(LNS) perldelta.pod perl511delta.pod
739
740   $makefile_SH =~ s!(
741 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
742         \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
743 )+!\0!gm;
744
745   verify_contiguous($name, $makefile_SH, 'copy rules');
746
747   my @copy_rules = map "
748 pod/$_: pod/$Copies{$_}
749         \$(LNS) $Copies{$_} pod/$_
750 ", keys %Copies;
751
752   $makefile_SH =~ s/\0+/join '', @copy_rules/se;
753   $makefile_SH;
754
755 }
756
757 # Do stuff
758
759 my $built;
760 while (my ($target, $name) = each %Targets) {
761   print "Working on target $target\n" if $Verbose;
762   next unless $Build{$target};
763   $built++;
764   if ($target eq "toc") {
765     print "Now processing $name\n" if $Verbose;
766     output_perltoc($name);
767     print "Finished\n" if $Verbose;
768     next;
769   }
770   print "Now processing $name\n" if $Verbose;
771   open THING, $name or die "Can't open $name: $!";
772   binmode THING;
773   my @orig = <THING>;
774   my $orig = join '', @orig;
775   close THING;
776   my @new = do {
777     no strict 'refs';
778     &{"do_$target"}($target, @orig);
779   };
780   my $new = join '', @new;
781   if ($new eq $orig) {
782     print "Was not modified\n" if $Verbose;
783     next;
784   }
785   my $mode = (stat $name)[2] // die "$0: Can't stat $name: $!";
786   rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
787   open THING, ">$name" or die "$0: Can't open $name for writing: $!";
788   binmode THING;
789   print THING $new or die "$0: print to $name failed: $!";
790   close THING or die "$0: close $name failed: $!";
791   chmod $mode & 0777, $name or die "$0: can't chmod $mode $name: $!";
792 }
793
794 warn "$0: was not instructed to build anything\n" unless $built;