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{perlpod_omit} = 1;
 115       $delta_source = "$filename.pod";
 116     }
 117     if ($flags =~ tr/d//d) {
 118       $flags{manifest_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   my (%sources);
 164
 165   # Convert these to a list of filenames.
 166   foreach (keys %Pods, keys %Readmepods) {
 167     $our_pods{"$_.pod"}++;
 168   }
 169
 170   # None of these filenames will be boolean false
 171   @disk_pods = glob("*.pod");
 172   @disk_pods{@disk_pods} = @disk_pods;
 173
 174   # Things we copy from won't be in perl.pod
 175   # Things we copy to won't be in MANIFEST
 176   @sources{values %Copies} = ();
 177
 178   open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
 179   while (<MANI>) {
 180     if (m!^pod/([^.]+\.pod)\s+!i) {
 181       push @manipods, $1;
 182     } elsif (m!^README\.(\S+)\s+!i) {
 183       next if $Ignore{$1};
 184       push @manireadmes, "perl$1.pod";
 185     }
 186   }
 187   close(MANI);
 188   @manipods{@manipods} = @manipods;
 189   @manireadmes{@manireadmes} = @manireadmes;
 190
 191   open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
 192   while (<PERLPOD>) {
 193     if (/^For ease of access, /../^\(If you're intending /) {
 194       if (/^\s+(perl\S*)\s+\w/) {
 195         push @perlpods, "$1.pod";
 196       }
 197     }
 198   }
 199   close(PERLPOD);
 200   die "$0: could not find the pod listing of perl.pod\n"
 201     unless @perlpods;
 202   @perlpods{@perlpods} = @perlpods;
 203
 204   foreach my $i (sort keys %disk_pods) {
 205     warn "$0: $i exists but is unknown by buildtoc\n"
 206       unless $our_pods{$i};
 207     warn "$0: $i exists but is unknown by ../MANIFEST\n"
 208       if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i};
 209     warn "$0: $i exists but is unknown by perl.pod\n"
 210         if !$perlpods{$i} && !exists $sources{$i};
 211   }
 212   my @BuildTargets = grep {defined} @Targets{grep $_ ne 'all', keys %Build};
 213   my %BuildFiles;
 214   @BuildFiles{@BuildTargets} = @BuildTargets;
 215
 216   foreach my $i (sort keys %our_pods) {
 217     warn "$0: $i is known by buildtoc but does not exist\n"
 218       unless $disk_pods{$i} or $BuildFiles{$i};
 219   }
 220   foreach my $i (sort keys %manipods) {
 221     warn "$0: $i is known by ../MANIFEST but does not exist\n"
 222       unless $disk_pods{$i};
 223     warn "$0: $i is known by ../MANIFEST but is marked as generated\n"
 224       if $Generated{$i};
 225   }
 226   foreach my $i (sort keys %perlpods) {
 227     warn "$0: $i is known by perl.pod but does not exist\n"
 228       unless $disk_pods{$i} or $BuildFiles{$i};
 229   }
 230 }
 231
 232 # Find all the modules
 233 {
 234   my @modpods;
 235   find \&getpods => qw(../lib ../ext);
 236
 237   sub getpods {
 238     if (/\.p(od|m)$/) {
 239       my $file = $File::Find::name;
 240       return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
 241       return if $file =~ m!(?:^|/)t/!;
 242       return if $file =~ m!lib/Attribute/Handlers/demo/!;
 243       return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
 244       return if $file =~ m!lib/Math/BigInt/t/!;
 245       return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
 246       return if $file =~ m!XS/(?:APItest|Typemap)!;
 247       my $pod = $file;
 248       return if $pod =~ s/pm$/pod/ && -e $pod;
 249       die "$0: tut $File::Find::name" if $file =~ /TUT/;
 250       unless (open (F, "< $_\0")) {
 251         warn "$0: bogus <$file>: $!";
 252         system "ls", "-l", $file;
 253       }
 254       else {
 255         my $line;
 256         while ($line = <F>) {
 257           if ($line =~ /^=head1\s+NAME\b/) {
 258             push @modpods, $file;
 259             #warn "GOOD $file\n";
 260             close F;
 261             return;
 262           }
 263         }
 264         close F;
 265         warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet;
 266       }
 267     }
 268   }
 269
 270   die "$0: no pods" unless @modpods;
 271
 272   my %done;
 273   for (@modpods) {
 274     #($name) = /(\w+)\.p(m|od)$/;
 275     my $name = path2modname($_);
 276     if ($name =~ /^[a-z]/) {
 277       $Pragmata{$name} = $_;
 278     } else {
 279       if ($done{$name}++) {
 280         # warn "already did $_\n";
 281         next;
 282       }
 283       $Modules{$name} = $_;
 284     }
 285   }
 286 }
 287
 288 # OK. Now a lot of ancillary function definitions follow
 289 # Main program returns at "Do stuff"
 290
 291 sub path2modname {
 292     local $_ = shift;
 293     s/\.p(m|od)$//;
 294     s-.*?/(lib|ext)/--;
 295     s-/-::-g;
 296     s/(\w+)::\1/$1/;
 297     return $_;
 298 }
 299
 300 sub output ($);
 301
 302 sub output_perltoc {
 303   open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
 304
 305   local $/ = '';
 306
 307   ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
 308
 309         # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 310         # This file is autogenerated by buildtoc from all the other pods.
 311         # Edit those files and run buildtoc --build-toc to effect changes.
 312
 313         =head1 NAME
 314
 315         perltoc - perl documentation table of contents
 316
 317         =head1 DESCRIPTION
 318
 319         This page provides a brief table of contents for the rest of the Perl
 320         documentation set.  It is meant to be scanned quickly or grepped
 321         through to locate the proper section you're looking for.
 322
 323         =head1 BASIC DOCUMENTATION
 324
 325 EOPOD2B
 326 #' make emacs happy
 327
 328   # All the things in the master list that happen to be pod filenames
 329   podset(map {"$_->[1].pod"} grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master);
 330
 331
 332   ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
 333
 334
 335
 336         =head1 PRAGMA DOCUMENTATION
 337
 338 EOPOD2B
 339
 340   podset(sort values %Pragmata);
 341
 342   ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
 343
 344
 345
 346         =head1 MODULE DOCUMENTATION
 347
 348 EOPOD2B
 349
 350   podset( @Modules{ sort keys %Modules } );
 351
 352   $_= <<"EOPOD2B";
 353
 354
 355         =head1 AUXILIARY DOCUMENTATION
 356
 357         Here should be listed all the extra programs' documentation, but they
 358         don't all have manual pages yet:
 359
 360         =over 4
 361
 362 EOPOD2B
 363
 364   $_ .=  join "\n", map {"\t=item $_\n"} sort keys %Aux;
 365   $_ .= <<"EOPOD2B" ;
 366
 367         =back
 368
 369         =head1 AUTHOR
 370
 371         Larry Wall <F<larry\@wall.org>>, with the help of oodles
 372         of other folks.
 373
 374
 375 EOPOD2B
 376
 377   s/^\t//gm;
 378   output $_;
 379   output "\n";                    # flush $LINE
 380   close OUT;
 381 }
 382
 383 # Below are all the auxiliary routines for generating perltoc.pod
 384
 385 my ($inhead1, $inhead2, $initem);
 386
 387 sub podset {
 388     local @ARGV = @_;
 389     my $pod;
 390
 391     return unless scalar(@ARGV);
 392
 393     while(<>) {
 394         tr/\015//d;
 395         if (s/^=head1 (NAME)\s*/=head2 /) {
 396             $pod = path2modname($ARGV);
 397             unhead1();
 398             output "\n \n\n=head2 ";
 399             $_ = <>;
 400             # Remove svn keyword expansions from the Perl FAQ
 401             s/ \(\$Revision: \d+ \$\)//g;
 402             if ( /^\s*$pod\b/ ) {
 403                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
 404                 output $_;
 405             } else {
 406                 s/^/$pod, /;
 407                 output $_;
 408             }
 409             next;
 410         }
 411         if (s/^=head1 (.*)/=item $1/) {
 412             unhead2();
 413             output "=over 4\n\n" unless $inhead1;
 414             $inhead1 = 1;
 415             output $_; nl(); next;
 416         }
 417         if (s/^=head2 (.*)/=item $1/) {
 418             unitem();
 419             output "=over 4\n\n" unless $inhead2;
 420             $inhead2 = 1;
 421             output $_; nl(); next;
 422         }
 423         if (s/^=item ([^=].*)/$1/) {
 424             next if $pod eq 'perldiag';
 425             s/^\s*\*\s*$// && next;
 426             s/^\s*\*\s*//;
 427             s/\n/ /g;
 428             s/\s+$//;
 429             next if /^[\d.]+$/;
 430             next if $pod eq 'perlmodlib' && /^ftp:/;
 431             ##print "=over 4\n\n" unless $initem;
 432             output ", " if $initem;
 433             $initem = 1;
 434             s/\.$//;
 435             s/^-X\b/-I<X>/;
 436             output $_; next;
 437         }
 438         if (s/^=cut\s*\n//) {
 439             unhead1();
 440             next;
 441         }
 442     }
 443 }
 444
 445 sub unhead1 {
 446     unhead2();
 447     if ($inhead1) {
 448         output "\n\n=back\n\n";
 449     }
 450     $inhead1 = 0;
 451 }
 452
 453 sub unhead2 {
 454     unitem();
 455     if ($inhead2) {
 456         output "\n\n=back\n\n";
 457     }
 458     $inhead2 = 0;
 459 }
 460
 461 sub unitem {
 462     if ($initem) {
 463         output "\n\n";
 464         ##print "\n\n=back\n\n";
 465     }
 466     $initem = 0;
 467 }
 468
 469 sub nl {
 470     output "\n";
 471 }
 472
 473 my $NEWLINE = 0;        # how many newlines have we seen recently
 474 my $LINE;               # what remains to be printed
 475
 476 sub output ($) {
 477     for (split /(\n)/, shift) {
 478         if ($_ eq "\n") {
 479             if ($LINE) {
 480                 print OUT wrap('', '', $LINE);
 481                 $LINE = '';
 482             }
 483             if (($NEWLINE) < 2) {
 484                 print OUT;
 485                 $NEWLINE++;
 486             }
 487         }
 488         elsif (/\S/ && length) {
 489             $LINE .= $_;
 490             $NEWLINE = 0;
 491         }
 492     }
 493 }
 494
 495 # End of original buildtoc. From here on are routines to generate new sections
 496 # for and inplace edit other files
 497
 498 sub generate_perlpod {
 499   my @output;
 500   my $maxlength = 0;
 501   foreach (@Master) {
 502     my $flags = $_->[0];
 503     next if $flags->{aux};
 504     next if $flags->{perlpod_omit};
 505
 506     if (@$_ == 2) {
 507       # Heading
 508       push @output, "=head2 $_->[1]\n";
 509     } elsif (@$_ == 3) {
 510       # Section
 511       my $start = " " x (4 + $flags->{indent}) . $_->[1];
 512       $maxlength = length $start if length ($start) > $maxlength;
 513       push @output, [$start, $_->[2]];
 514     } elsif (@$_ == 0) {
 515       # blank line
 516       push @output, "\n";
 517     } else {
 518       die "$0: Illegal length " . scalar @$_;
 519     }
 520   }
 521   # want at least 2 spaces padding
 522   $maxlength += 2;
 523   $maxlength = ($maxlength + 3) & ~3;
 524   # sprintf gives $1.....$2 where ... are spaces:
 525   return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
 526                    @output);
 527 }
 528
 529
 530 sub generate_manifest {
 531   # Annyoingly unexpand doesn't consider it good form to replace a single
 532   # space before a tab with a tab
 533   # Annoyingly (2) it returns read only values.
 534   my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
 535   map {s/ \t/\t\t/g; $_} @temp;
 536 }
 537 sub generate_manifest_pod {
 538   generate_manifest map {["pod/$_.pod", $Pods{$_}]}
 539     sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
 540 }
 541 sub generate_manifest_readme {
 542   generate_manifest sort {$a->[0] cmp $b->[0]}
 543     ["README.vms", "Notes about installing the VMS port"],
 544       map {["README.$_", $Readmes{$_}]} keys %Readmes;
 545 }
 546
 547 sub generate_roffitall {
 548   (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
 549    "\t\t\\",
 550    map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
 551    "\t\t\\",
 552    map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
 553    "\t\t\\",
 554    map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
 555   )
 556 }
 557
 558 sub generate_descrip_mms_1 {
 559   local $Text::Wrap::columns = 150;
 560   my $count = 0;
 561   my @lines = map {"pod" . $count++ . " = $_"}
 562     split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
 563                      sort keys %Pods, keys %Readmepods);
 564   @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
 565 }
 566
 567 sub generate_descrip_mms_2 {
 568   map {<<"SNIP"}
 569 [.lib.pods]$_.pod : [.pod]$_.pod
 570         \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
 571         Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
 572 SNIP
 573    sort keys %Pods, keys %Readmepods;
 574 }
 575
 576 sub generate_descrip_mms_3 {
 577   map qq{\t- If F\$Search("[.pod]$_").nes."" Then Delete/NoConfirm/Log [.pod]$_;*},
 578     sort keys %Generated, keys %Copies;
 579 }
 580
 581 sub generate_nmake_1 {
 582   # XXX Fix this with File::Spec
 583   (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
 584     sort keys %Readmes),
 585       (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
 586 }
 587
 588 # This doesn't have a trailing newline
 589 sub generate_nmake_2 {
 590   # Spot the special case
 591   local $Text::Wrap::columns = 76;
 592   my $line = wrap ("\t    ", "\t    ",
 593                    join " ", sort keys %Copies, keys %Generated,
 594                                   map {"perl$_.pod"} keys %Readmes);
 595   $line =~ s/$/ \\/mg;
 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 = shift;
 618   my @manifest =
 619     grep {! m!^pod/[^.]+\.pod.*\n!}
 620       grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
 621   # Dictionary order - fold and handle non-word chars as nothing
 622   map  { $_->[0] }
 623   sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
 624   map  { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
 625     @manifest,
 626       &generate_manifest_pod(),
 627         &generate_manifest_readme();
 628 }
 629
 630 sub do_nmake {
 631   my $name = shift;
 632   my $makefile = join '', @_;
 633   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
 634   $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
 635   verify_contiguous($name, $makefile, 'README copies');
 636   # Now remove the other copies that follow
 637   1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
 638   $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
 639
 640   $makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
 641     {"$1\n" . &generate_nmake_2."\n\t    $2"}se;
 642   $makefile;
 643 }
 644
 645 # shut up used only once warning
 646 *do_dmake = *do_dmake = \&do_nmake;
 647
 648 sub do_perlpod {
 649   my $name = shift;
 650   my $pod = join '', @_;
 651
 652   unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
 653                     (?:\s+[a-z]{4,}.*\n #   fooo
 654                     |=head.*\n          # =head foo
 655                     |\s*\n              # blank line
 656                    )+
 657                   }
 658           {$1 . join "", &generate_perlpod}mxe) {
 659     die "$0: Failed to insert amendments in do_perlpod";
 660   }
 661   $pod;
 662 }
 663
 664 sub do_podmak {
 665   my $name = shift;
 666   my $body = join '', @_;
 667   foreach my $variable (qw(pod man html tex)) {
 668     die "$0: could not find $variable in $name"
 669       unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
 670         {"\n" . generate_pod_mak ($variable)}se;
 671   }
 672   $body;
 673 }
 674
 675 sub do_vms {
 676   my $name = shift;
 677   my $makefile = join '', @_;
 678   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
 679   $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
 680   verify_contiguous($name, $makefile, 'pod assignments');
 681   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
 682
 683   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
 684
 685 # Looking for rules like this
 686 # [.lib.pods]perl.pod : [.pod]perl.pod
 687 #       @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
 688 #       Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
 689
 690   $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
 691                  [^\n]+\n       # Another line
 692                  [^\n]+\Q[.lib.pods]\E\n                # ends [.lib.pods]
 693                     /\0/gsx;
 694   verify_contiguous($name, $makefile, 'copy rules');
 695   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
 696
 697 # Looking for rules like this:
 698 #       - If F$Search("[.pod]perldelta.pod").nes."" Then Delete/NoConfirm/Log [.pod]perldelta.pod;*
 699   $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;
 700   verify_contiguous($name, $makefile, 'delete rules');
 701   $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/se;
 702
 703   $makefile;
 704 }
 705
 706 sub do_unix {
 707   my $name = shift;
 708   my $makefile_SH = join '', @_;
 709   die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
 710
 711   $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
 712                    {join ' ', $1, map "pod/$_",
 713                         sort keys %Copies, grep {!/perltoc/} keys %Generated
 714                     }mge;
 715
 716 # pod/perldelta.pod: pod/perl511delta.pod
 717 #       cd pod && $(LNS) perl511delta.pod perldelta.pod
 718
 719   $makefile_SH =~ s!(
 720 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
 721         \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
 722 )+!\0!gm;
 723
 724   verify_contiguous($name, $makefile_SH, 'copy rules');
 725
 726   my @copy_rules = map "
 727 pod/$_: pod/$Copies{$_}
 728         \$(LNS) $Copies{$_} pod/$_
 729 ", keys %Copies;
 730
 731   $makefile_SH =~ s/\0+/join '', @copy_rules/se;
 732   $makefile_SH;
 733
 734 }
 735
 736 # Do stuff
 737
 738 my $built;
 739 while (my ($target, $name) = each %Targets) {
 740   print "Working on target $target\n" if $Verbose;
 741   next unless $Build{$target};
 742   $built++;
 743   if ($target eq "toc") {
 744     print "Now processing $name\n" if $Verbose;
 745     &output_perltoc;
 746     print "Finished\n" if $Verbose;
 747     next;
 748   }
 749   print "Now processing $name\n" if $Verbose;
 750   open THING, $name or die "Can't open $name: $!";
 751   binmode THING;
 752   my @orig = <THING>;
 753   my $orig = join '', @orig;
 754   close THING;
 755   my @new = do {
 756     no strict 'refs';
 757     &{"do_$target"}($target, @orig);
 758   };
 759   my $new = join '', @new;
 760   if ($new eq $orig) {
 761     print "Was not modified\n" if $Verbose;
 762     next;
 763   }
 764   rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
 765   open THING, ">$name" or die "$0: Can't open $name for writing: $!";
 766   binmode THING;
 767   print THING $new or die "$0: print to $name failed: $!";
 768   close THING or die "$0: close $name failed: $!";
 769 }
 770
 771 warn "$0: was not instructed to build anything\n" unless $built;