pod/buildtoc

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