This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Automate current perldelta entry in vms/descrip_mms.template.
[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 source";
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     next if $done{$name}++;
307
308     if ($name =~ /^[a-z]/) {
309       $Pragmata{$name} = $_;
310     } else {
311       $Modules{$name} = $_;
312     }
313   }
314 }
315
316 # OK. Now a lot of ancillary function definitions follow
317 # Main program returns at "Do stuff"
318
319 my $OUT;
320
321 sub output_perltoc {
322   my $filename = shift;
323
324   ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
325
326         # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
327         # This file is autogenerated by buildtoc from all the other pods.
328         # Edit those files and run buildtoc --build-toc to effect changes.
329
330         =head1 NAME
331
332         perltoc - perl documentation table of contents
333
334         =head1 DESCRIPTION
335
336         This page provides a brief table of contents for the rest of the Perl
337         documentation set.  It is meant to be scanned quickly or grepped
338         through to locate the proper section you're looking for.
339
340         =head1 BASIC DOCUMENTATION
341
342 EOPOD2B
343 #' make emacs happy
344
345   # All the things in the master list that happen to be pod filenames
346   foreach (grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master) {
347     podset($_->[1], abs_from_top("pod/$_->[1].pod"));
348   }
349
350
351   ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
352
353
354
355         =head1 PRAGMA DOCUMENTATION
356
357 EOPOD2B
358
359   foreach (sort keys %Pragmata) {
360     podset($_, $Pragmata{$_});
361   }
362
363   ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
364
365
366
367         =head1 MODULE DOCUMENTATION
368
369 EOPOD2B
370
371   foreach (sort keys %Modules) {
372     podset($_, $Modules{$_});
373   }
374
375   $_= <<"EOPOD2B";
376
377
378         =head1 AUXILIARY DOCUMENTATION
379
380         Here should be listed all the extra programs' documentation, but they
381         don't all have manual pages yet:
382
383         =over 4
384
385 EOPOD2B
386
387   $_ .=  join "\n", map {"\t=item $_\n"} sort keys %Aux;
388   $_ .= <<"EOPOD2B" ;
389
390         =back
391
392         =head1 AUTHOR
393
394         Larry Wall <F<larry\@wall.org>>, with the help of oodles
395         of other folks.
396
397
398 EOPOD2B
399
400   s/^\t//gm;
401   $OUT .= "$_\n";
402
403   $OUT =~ s/\n\s+\n/\n\n/gs;
404   $OUT =~ s/\n{3,}/\n\n/g;
405
406   $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
407
408   open OUT, '>', $filename or die "$0: creating $filename failed: $!";
409   print OUT $OUT;
410   close OUT;
411 }
412
413 # Below are all the auxiliary routines for generating perltoc.pod
414
415 my ($inhead1, $inhead2, $initem);
416
417 sub podset {
418     my ($pod, $file) = @_;
419
420     local $/ = '';
421
422     open my $fh, '<', $file or die "Can't open file '$file' for $pod: $!";
423
424     while(<$fh>) {
425         tr/\015//d;
426         if (s/^=head1 (NAME)\s*/=head2 /) {
427             unhead1();
428             $OUT .= "\n\n=head2 ";
429             $_ = <$fh>;
430             # Remove svn keyword expansions from the Perl FAQ
431             s/ \(\$Revision: \d+ \$\)//g;
432             if ( /^\s*\Q$pod\E\b/ ) {
433                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
434             } else {
435                 s/^/$pod, /;
436             }
437         }
438         elsif (s/^=head1 (.*)/=item $1/) {
439             unhead2();
440             $OUT .= "=over 4\n\n" unless $inhead1;
441             $inhead1 = 1;
442             $_ .= "\n";
443         }
444         elsif (s/^=head2 (.*)/=item $1/) {
445             unitem();
446             $OUT .= "=over 4\n\n" unless $inhead2;
447             $inhead2 = 1;
448             $_ .= "\n";
449         }
450         elsif (s/^=item ([^=].*)/$1/) {
451             next if $pod eq 'perldiag';
452             s/^\s*\*\s*$// && next;
453             s/^\s*\*\s*//;
454             s/\n/ /g;
455             s/\s+$//;
456             next if /^[\d.]+$/;
457             next if $pod eq 'perlmodlib' && /^ftp:/;
458             $OUT .= ", " if $initem;
459             $initem = 1;
460             s/\.$//;
461             s/^-X\b/-I<X>/;
462         }
463         else {
464             unhead1() if /^=cut\s*\n/;
465             next;
466         }
467         $OUT .= $_;
468     }
469 }
470
471 sub unhead1 {
472     unhead2();
473     if ($inhead1) {
474         $OUT .= "\n\n=back\n\n";
475     }
476     $inhead1 = 0;
477 }
478
479 sub unhead2 {
480     unitem();
481     if ($inhead2) {
482         $OUT .= "\n\n=back\n\n";
483     }
484     $inhead2 = 0;
485 }
486
487 sub unitem {
488     if ($initem) {
489         $OUT .= "\n\n";
490     }
491     $initem = 0;
492 }
493
494 # End of original buildtoc. From here on are routines to generate new sections
495 # for and inplace edit other files
496
497 sub generate_perlpod {
498   my @output;
499   my $maxlength = 0;
500   foreach (@Master) {
501     my $flags = $_->[0];
502     next if $flags->{aux};
503     next if $flags->{perlpod_omit};
504
505     if (@$_ == 2) {
506       # Heading
507       push @output, "=head2 $_->[1]\n";
508     } elsif (@$_ == 3) {
509       # Section
510       my $start = " " x (4 + $flags->{indent}) . $_->[1];
511       $maxlength = length $start if length ($start) > $maxlength;
512       push @output, [$start, $_->[2]];
513     } elsif (@$_ == 0) {
514       # blank line
515       push @output, "\n";
516     } else {
517       die "$0: Illegal length " . scalar @$_;
518     }
519   }
520   # want at least 2 spaces padding
521   $maxlength += 2;
522   $maxlength = ($maxlength + 3) & ~3;
523   # sprintf gives $1.....$2 where ... are spaces:
524   return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
525                    @output);
526 }
527
528
529 sub generate_manifest {
530   # Annoyingly, unexpand doesn't consider it good form to replace a single
531   # space before a tab with a tab
532   # Annoyingly (2) it returns read only values.
533   my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
534   map {s/ \t/\t\t/g; $_} @temp;
535 }
536 sub generate_manifest_pod {
537   generate_manifest map {["pod/$_.pod", $Pods{$_}]}
538     sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
539 }
540 sub generate_manifest_readme {
541   generate_manifest sort {$a->[0] cmp $b->[0]}
542     ["README.vms", "Notes about installing the VMS port"],
543       map {["README.$_", $Readmes{$_}]} keys %Readmes;
544 }
545
546 sub generate_roffitall {
547   (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
548    "\t\t\\",
549    map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
550    "\t\t\\",
551    map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
552    "\t\t\\",
553    map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
554   )
555 }
556
557 sub generate_descrip_mms_1 {
558   local $Text::Wrap::columns = 150;
559   my $count = 0;
560   my @lines = map {"pod" . $count++ . " = $_"}
561     split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
562                      sort keys %Pods, keys %Readmepods);
563   @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
564 }
565
566 sub generate_descrip_mms_2 {
567   map {<<"SNIP"}
568 [.lib.pods]$_.pod : [.pod]$_.pod
569         \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
570         Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
571 SNIP
572    sort keys %Pods, keys %Readmepods;
573 }
574
575 sub generate_nmake_1 {
576   # XXX Fix this with File::Spec
577   (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
578     sort keys %Readmes),
579       (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
580 }
581
582 # This doesn't have a trailing newline
583 sub generate_nmake_2 {
584   # Spot the special case
585   local $Text::Wrap::columns = 76;
586   my $line = wrap ("\t    ", "\t    ",
587                    join " ", sort keys %Copies, keys %Generated,
588                                   map {"perl$_.pod"} keys %Readmes);
589   $line =~ s/$/ \\/mg;
590   $line =~ s/ \\$//;
591   $line;
592 }
593
594 sub generate_pod_mak {
595   my $variable = shift;
596   my @lines;
597   my $line = join "\\\n", "\U$variable = ",
598     map {"\t$_.$variable\t"} sort keys %Pods;
599   # Special case
600   $line =~ s/.*perltoc.html.*\n//m;
601   $line;
602 }
603
604 sub verify_contiguous {
605   my ($name, $content, $what) = @_;
606   my $sections = () = $content =~ m/\0+/g;
607   croak("$0: $name contains no $what") if $sections < 1;
608   croak("$0: $name contains discontiguous $what") if $sections > 1;
609 }
610
611 sub do_manifest {
612   my $name = shift;
613   my @manifest =
614     grep {! m!^pod/[^.]+\.pod.*\n!}
615       grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
616   # Dictionary order - fold and handle non-word chars as nothing
617   map  { $_->[0] }
618   sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
619   map  { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
620     @manifest,
621       &generate_manifest_pod(),
622         &generate_manifest_readme();
623 }
624
625 sub do_nmake {
626   my $name = shift;
627   my $makefile = join '', @_;
628   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
629   $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
630   verify_contiguous($name, $makefile, 'README copies');
631   # Now remove the other copies that follow
632   1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
633   $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
634
635   $makefile =~ s{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)}
636     {"$1\n" . &generate_nmake_2."\n\t$2"}se;
637   $makefile;
638 }
639
640 # shut up used only once warning
641 *do_dmake = *do_dmake = \&do_nmake;
642
643 sub do_perlpod {
644   my $name = shift;
645   my $pod = join '', @_;
646
647   unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
648                     (?:\s+[a-z]{4,}.*\n #   fooo
649                     |=head.*\n          # =head foo
650                     |\s*\n              # blank line
651                    )+
652                   }
653           {$1 . join "", &generate_perlpod}mxe) {
654     die "$0: Failed to insert amendments in do_perlpod";
655   }
656   $pod;
657 }
658
659 sub do_podmak {
660   my $name = shift;
661   my $body = join '', @_;
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 = shift;
672   my $makefile = join '', @_;
673   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
674   $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
675   verify_contiguous($name, $makefile, 'pod assignments');
676   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
677
678   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
679
680 # Looking for the macro defining the current perldelta:
681 #PERLDELTA_CURRENT = [.pod]perl5139delta.pod
682
683   $makefile =~ s/\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n
684                     /\0/sx;
685   verify_contiguous($name, $makefile, 'current perldelta macro');
686   $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$delta_target", ''/se;
687
688 # Looking for rules like this
689 # [.lib.pods]perl.pod : [.pod]perl.pod
690 #       @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
691 #       Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
692
693   $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
694                  [^\n]+\n       # Another line
695                  [^\n]+\Q[.lib.pods]\E\n                # ends [.lib.pods]
696                     /\0/gsx;
697   verify_contiguous($name, $makefile, 'copy rules');
698   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
699
700   $makefile;
701 }
702
703 sub do_unix {
704   my $name = shift;
705   my $makefile_SH = join '', @_;
706   die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
707
708   $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
709                    {join ' ', $1, map "pod/$_",
710                         sort keys %Copies, grep {!/perltoc/} keys %Generated
711                     }mge;
712
713 # pod/perl511delta.pod: pod/perldelta.pod
714 #       cd pod && $(LNS) perldelta.pod perl511delta.pod
715
716   $makefile_SH =~ s!(
717 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
718         \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
719 )+!\0!gm;
720
721   verify_contiguous($name, $makefile_SH, 'copy rules');
722
723   my @copy_rules = map "
724 pod/$_: pod/$Copies{$_}
725         \$(LNS) $Copies{$_} pod/$_
726 ", keys %Copies;
727
728   $makefile_SH =~ s/\0+/join '', @copy_rules/se;
729   $makefile_SH;
730
731 }
732
733 # Do stuff
734
735 my $built;
736 while (my ($target, $name) = each %Targets) {
737   print "Working on target $target\n" if $Verbose;
738   next unless $Build{$target};
739   $built++;
740   if ($target eq "toc") {
741     print "Now processing $name\n" if $Verbose;
742     output_perltoc($name);
743     print "Finished\n" if $Verbose;
744     next;
745   }
746   print "Now processing $name\n" if $Verbose;
747   open THING, $name or die "Can't open $name: $!";
748   binmode THING;
749   my @orig = <THING>;
750   my $orig = join '', @orig;
751   close THING;
752   my @new = do {
753     no strict 'refs';
754     &{"do_$target"}($target, @orig);
755   };
756   my $new = join '', @new;
757   if ($new eq $orig) {
758     print "Was not modified\n" if $Verbose;
759     next;
760   }
761   my $mode = (stat $name)[2] // die "$0: Can't stat $name: $!";
762   rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
763   open THING, ">$name" or die "$0: Can't open $name for writing: $!";
764   binmode THING;
765   print THING $new or die "$0: print to $name failed: $!";
766   close THING or die "$0: close $name failed: $!";
767   chmod $mode & 0777, $name or die "$0: can't chmod $mode $name: $!";
768 }
769
770 warn "$0: was not instructed to build anything\n" unless $built;