pod/buildtoc

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