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