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