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 = join "\\\n", "\U$variable = ",
 630     map {"\t$_.$variable\t"} 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;