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