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