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