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      Y2K => 1,
  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 ancillay 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             if ( /^\s*$pod\b/ ) {
 387                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
 388                 output $_;
 389             } else {
 390                 s/^/$pod, /;
 391                 output $_;
 392             }
 393             next;
 394         }
 395         if (s/^=head1 (.*)/=item $1/) {
 396             unhead2();
 397             output "=over 4\n\n" unless $inhead1;
 398             $inhead1 = 1;
 399             output $_; nl(); next;
 400         }
 401         if (s/^=head2 (.*)/=item $1/) {
 402             unitem();
 403             output "=over 4\n\n" unless $inhead2;
 404             $inhead2 = 1;
 405             output $_; nl(); next;
 406         }
 407         if (s/^=item ([^=].*)/$1/) {
 408             next if $pod eq 'perldiag';
 409             s/^\s*\*\s*$// && next;
 410             s/^\s*\*\s*//;
 411             s/\n/ /g;
 412             s/\s+$//;
 413             next if /^[\d.]+$/;
 414             next if $pod eq 'perlmodlib' && /^ftp:/;
 415             ##print "=over 4\n\n" unless $initem;
 416             output ", " if $initem;
 417             $initem = 1;
 418             s/\.$//;
 419             s/^-X\b/-I<X>/;
 420             output $_; next;
 421         }
 422         if (s/^=cut\s*\n//) {
 423             unhead1();
 424             next;
 425         }
 426     }
 427 }
 428
 429 sub unhead1 {
 430     unhead2();
 431     if ($inhead1) {
 432         output "\n\n=back\n\n";
 433     }
 434     $inhead1 = 0;
 435 }
 436
 437 sub unhead2 {
 438     unitem();
 439     if ($inhead2) {
 440         output "\n\n=back\n\n";
 441     }
 442     $inhead2 = 0;
 443 }
 444
 445 sub unitem {
 446     if ($initem) {
 447         output "\n\n";
 448         ##print "\n\n=back\n\n";
 449     }
 450     $initem = 0;
 451 }
 452
 453 sub nl {
 454     output "\n";
 455 }
 456
 457 my $NEWLINE = 0;        # how many newlines have we seen recently
 458 my $LINE;               # what remains to be printed
 459
 460 sub output ($) {
 461     for (split /(\n)/, shift) {
 462         if ($_ eq "\n") {
 463             if ($LINE) {
 464                 print OUT wrap('', '', $LINE);
 465                 $LINE = '';
 466             }
 467             if (($NEWLINE) < 2) {
 468                 print OUT;
 469                 $NEWLINE++;
 470             }
 471         }
 472         elsif (/\S/ && length) {
 473             $LINE .= $_;
 474             $NEWLINE = 0;
 475         }
 476     }
 477 }
 478
 479 # End of original buildtoc. From here on are routines to generate new sections
 480 # for and inplace edit other files
 481
 482 sub generate_perlpod {
 483   my @output;
 484   my $maxlength = 0;
 485   foreach (@Master) {
 486     my $flags = $_->[0];
 487     next if $flags->{aux};
 488     next if $flags->{perlpod_omit};
 489
 490     if (@$_ == 2) {
 491       # Heading
 492       push @output, "=head2 $_->[1]\n";
 493     } elsif (@$_ == 3) {
 494       # Section
 495       my $start = " " x (4 + $flags->{indent}) . $_->[1];
 496       $maxlength = length $start if length ($start) > $maxlength;
 497       push @output, [$start, $_->[2]];
 498     } elsif (@$_ == 0) {
 499       # blank line
 500       push @output, "\n";
 501     } else {
 502       die "$0: Illegal length " . scalar @$_;
 503     }
 504   }
 505   # want at least 2 spaces padding
 506   $maxlength += 2;
 507   $maxlength = ($maxlength + 3) & ~3;
 508   # sprintf gives $1.....$2 where ... are spaces:
 509   return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
 510                    @output);
 511 }
 512
 513
 514 sub generate_manifest {
 515   # Annyoingly unexpand doesn't consider it good form to replace a single
 516   # space before a tab with a tab
 517   # Annoyingly (2) it returns read only values.
 518   my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
 519   map {s/ \t/\t\t/g; $_} @temp;
 520 }
 521 sub generate_manifest_pod {
 522   generate_manifest map {["pod/$_.pod", $Pods{$_}]}
 523     grep {!$Copies{"$_.pod"}} sort keys %Pods;
 524 }
 525 sub generate_manifest_readme {
 526   generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
 527 }
 528
 529 sub generate_roffitall {
 530   (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
 531    "\t\t\\",
 532    map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
 533    "\t\t\\",
 534    map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
 535    "\t\t\\",
 536    map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
 537   )
 538 }
 539
 540 sub generate_descrip_mms_1 {
 541   local $Text::Wrap::columns = 150;
 542   my $count = 0;
 543   my @lines = map {"pod" . $count++ . " = $_"}
 544     split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
 545                      sort keys %Pods, keys %Readmepods);
 546   @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
 547 }
 548
 549 sub generate_descrip_mms_2 {
 550   map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
 551 [.lib.pods]%s.pod : [.%s]%s.pod
 552         @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
 553         Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
 554 SNIP
 555    sort keys %Pods, keys %Readmepods;
 556 }
 557
 558 sub generate_nmake_1 {
 559   # XXX Fix this with File::Spec
 560   (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
 561     sort keys %Readmes),
 562       (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
 563 }
 564
 565 # This doesn't have a trailing newline
 566 sub generate_nmake_2 {
 567   # Spot the special case
 568   local $Text::Wrap::columns = 76;
 569   my $line = wrap ("\t    ", "\t    ",
 570                    join " ", sort keys %Copies,
 571                                   map {"perl$_.pod"} "vms", keys %Readmes);
 572   $line =~ s/$/ \\/mg;
 573   $line;
 574 }
 575
 576 sub generate_pod_mak {
 577   my $variable = shift;
 578   my @lines;
 579   my $line = join "\\\n", "\U$variable = ",
 580     map {"\t$_.$variable\t"} sort keys %Pods;
 581   # Special case
 582   $line =~ s/.*perltoc.html.*\n//m;
 583   $line;
 584 }
 585
 586 sub do_manifest {
 587   my $name = shift;
 588   my @manifest =
 589     grep {! m!^pod/[^.]+\.pod.*\n!}
 590       grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
 591   # Dictionary order - fold and handle non-word chars as nothing
 592   map  { $_->[0] }
 593   sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
 594   map  { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
 595     @manifest,
 596       &generate_manifest_pod(),
 597         &generate_manifest_readme();
 598 }
 599
 600 sub do_nmake {
 601   my $name = shift;
 602   my $makefile = join '', @_;
 603   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
 604   $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
 605   my $sections = () = $makefile =~ m/\0+/g;
 606   die "$0: $name contains no README copies" if $sections < 1;
 607   die "$0: $name contains discontiguous README copies" if $sections > 1;
 608   # Now remove the other copies that follow
 609   1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
 610   $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
 611
 612   $makefile =~ s{(del /f [^\n]+checkpods[^\n]+).*?(pod2html)}
 613     {"$1\n" . &generate_nmake_2."\n\t    $2"}se;
 614   $makefile;
 615 }
 616
 617 # shut up used only once warning
 618 *do_dmake = *do_dmake = \&do_nmake;
 619
 620 sub do_perlpod {
 621   my $name = shift;
 622   my $pod = join '', @_;
 623
 624   unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
 625                     (?:\s+[a-z]{4,}.*\n #   fooo
 626                     |=head.*\n          # =head foo
 627                     |\s*\n              # blank line
 628                    )+
 629                   }
 630           {$1 . join "", &generate_perlpod}mxe) {
 631     die "$0: Failed to insert ammendments in do_perlpod";
 632   }
 633   $pod;
 634 }
 635
 636 sub do_podmak {
 637   my $name = shift;
 638   my $body = join '', @_;
 639   foreach my $variable (qw(pod man html tex)) {
 640     die "$0: could not find $variable in $name"
 641       unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
 642         {"\n" . generate_pod_mak ($variable)}se;
 643   }
 644   $body;
 645 }
 646
 647 sub do_vms {
 648   my $name = shift;
 649   my $makefile = join '', @_;
 650   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
 651   $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
 652   my $sections = () = $makefile =~ m/\0+/g;
 653   die "$0: $name contains no pod assignments" if $sections < 1;
 654   die "$0: $name contains $sections discontigous pod assignments"
 655     if $sections > 1;
 656   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
 657
 658   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
 659
 660 # Looking for rules like this
 661 # [.lib.pods]perl.pod : [.pod]perl.pod
 662 #       @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
 663 #       Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
 664
 665   $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
 666                  [^\n]+\n       # Another line
 667                  [^\n]+\Q[.lib.pods]\E\n                # ends [.lib.pods]
 668                     /\0/gsx;
 669   $sections = () = $makefile =~ m/\0+/g;
 670   die "$0: $name contains no copy rules" if $sections < 1;
 671   die "$0: $name contains $sections discontigous copy rules"
 672     if $sections > 1;
 673   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
 674   $makefile;
 675 }
 676
 677 sub do_unix {
 678   my $name = shift;
 679   my $makefile_SH = join '', @_;
 680   die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
 681
 682   $makefile_SH =~ s/\n\s+-\@test -f \S+ && cd pod && \$\(LNS\) \S+ \S+ && cd \.\. && echo "\S+" >> extra.pods \# See buildtoc\n/\0/gm;
 683
 684   my $sections = () = $makefile_SH =~ m/\0+/g;
 685
 686   die "$0: $name contains no copy rules" if $sections < 1;
 687   die "$0: $name contains $sections discontigous copy rules"
 688     if $sections > 1;
 689
 690   my @copy_rules = map "\t-\@test -f pod/$Copies{$_} && cd pod && \$(LNS) $Copies{$_} $_ && cd .. && echo \"pod/$_\" >> extra.pods # See buildtoc",
 691     keys %Copies;
 692
 693   $makefile_SH =~ s/\0+/join "\n", '', @copy_rules, ''/se;
 694   $makefile_SH;
 695
 696 }
 697
 698 # Do stuff
 699
 700 my $built;
 701 while (my ($target, $name) = each %Targets) {
 702   next unless $Build{$target};
 703   $built++;
 704   if ($target eq "toc") {
 705     print "Now processing $name\n" if $Verbose;
 706     &output_perltoc;
 707     print "Finished\n" if $Verbose;
 708     next;
 709   }
 710   print "Now processing $name\n" if $Verbose;
 711   open THING, $name or die "Can't open $name: $!";
 712   my @orig = <THING>;
 713   my $orig = join '', @orig;
 714   close THING;
 715   my @new = do {
 716     no strict 'refs';
 717     &{"do_$target"}($target, @orig);
 718   };
 719   my $new = join '', @new;
 720   if ($new eq $orig) {
 721     print "Was not modified\n" if $Verbose;
 722     next;
 723   }
 724   rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
 725   open THING, ">$name" or die "$0: Can't open $name for writing: $!";
 726   print THING $new or die "$0: print to $name failed: $!";
 727   close THING or die die "$0: close $name failed: $!";
 728 }
 729
 730 warn "$0: was not instructed to build anything\n" unless $built;