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