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