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