pod/buildtoc

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