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 use Carp;
  14
  15 no locale;
  16
  17 $Up = File::Spec->updir;
  18 $masterpodfile = File::Spec->catdir($Up, "pod.lst");
  19
  20 # Generate any/all of these files
  21 # --verbose gives slightly more output
  22 # --quiet suppresses routine warnings
  23 # --build-all tries to build everything
  24 # --build-foo updates foo as follows
  25 # --showfiles shows the files to be changed
  26
  27 %Targets
  28   = (
  29      toc => "perltoc.pod",
  30      manifest => File::Spec->catdir($Up, "MANIFEST"),
  31      perlpod => "perl.pod",
  32      vms => File::Spec->catdir($Up, "vms", "descrip_mms.template"),
  33      nmake => File::Spec->catdir($Up, "win32", "Makefile"),
  34      dmake => File::Spec->catdir($Up, "win32", "makefile.mk"),
  35      podmak => File::Spec->catdir($Up, "win32", "pod.mak"),
  36      # plan9 =>  File::Spec->catdir($Up, "plan9", "mkfile"),
  37      unix => File::Spec->catdir($Up, "Makefile.SH"),
  38      # TODO: add roffitall
  39     );
  40
  41 {
  42   my @files = keys %Targets;
  43   my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
  44   my $showfiles;
  45   die <<__USAGE__
  46 $0: Usage: $0 [--verbose] [--showfiles] $filesopts
  47 __USAGE__
  48   unless @ARGV
  49         && GetOptions (verbose => \$Verbose,
  50                        quiet => \$Quiet,
  51                        showfiles => \$showfiles,
  52                        map {+"build-$_", \$Build{$_}} @files, 'all');
  53   # Set them all to true
  54   @Build{@files} = @files if ($Build{all});
  55   if ($showfiles) {
  56       print
  57           join(" ",
  58                sort { lc $a cmp lc $b }
  59                map {
  60                    my ($v, $d, $f) = File::Spec->splitpath($_);
  61                    my @d;
  62                    @d = defined $d ? File::Spec->splitdir($d) : ();
  63                    shift @d if @d;
  64                    File::Spec->catfile(@d ?
  65                                        (@d == 1 && $d[0] eq '' ? () : @d)
  66                                        : "pod", $f);
  67                } @Targets{grep { $_ ne 'all' && $Build{$_} } keys %Build}),
  68           "\n";
  69       exit(0);
  70   }
  71 }
  72
  73 # Don't copy these top level READMEs
  74 %Ignore
  75   = (
  76      micro => 1,
  77 #     vms => 1,
  78      );
  79
  80 if ($Verbose) {
  81   print "I'm building $_\n" foreach grep {$Build{$_}} keys %Build;
  82 }
  83
  84 chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";
  85
  86 open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!";
  87
  88 my ($delta_source, $delta_target);
  89
  90 foreach (<MASTER>) {
  91   next if /^\#/;
  92
  93   # At least one upper case letter somewhere in the first group
  94   if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
  95     # it's a heading
  96     my $flags = $1;
  97     $flags =~ tr/h//d;
  98     my %flags = (header => 1);
  99     $flags{toc_omit} = 1 if $flags =~ tr/o//d;
 100     $flags{aux} = 1 if $flags =~ tr/a//d;
 101     die "$0: Unknown flag found in heading line: $_" if length $flags;
 102     push @Master, [\%flags, $2];
 103
 104   } elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
 105     # it's a section
 106     my ($flags, $filename, $desc) = ($1, $2, $3);
 107
 108     my %flags = (indent => 0);
 109     $flags{indent} = $1 if $flags =~ s/(\d+)//;
 110     $flags{toc_omit} = 1 if $flags =~ tr/o//d;
 111     $flags{aux} = 1 if $flags =~ tr/a//d;
 112
 113     if ($flags =~ tr/D//d) {
 114       $flags{perlpod_omit} = 1;
 115       $delta_source = "$filename.pod";
 116     }
 117     if ($flags =~ tr/d//d) {
 118       $flags{manifest_omit} = 1;
 119       $delta_target = "$filename.pod";
 120     }
 121     $Generated{"$filename.pod"}++ if $flags =~ tr/g//d;
 122
 123     if ($flags =~ tr/r//d) {
 124       my $readme = $filename;
 125       $readme =~ s/^perl//;
 126       $Readmepods{$filename} = $Readmes{$readme} = $desc;
 127       $flags{readme} = 1;
 128     } elsif ($flags{aux}) {
 129       $Aux{$filename} = $desc;
 130     } else {
 131       $Pods{$filename} = $desc;
 132     }
 133     die "$0: Unknown flag found in section line: $_" if length $flags;
 134     push @Master, [\%flags, $filename, $desc];
 135   } elsif (/^$/) {
 136     push @Master, undef;
 137   } else {
 138     die "$0: Malformed line: $_" if $1 =~ tr/A-Z//;
 139   }
 140 }
 141 if (defined $delta_source) {
 142   if (defined $delta_target) {
 143     # This way round so that keys can act as a MANIFEST skip list
 144     # Targets will aways be in the pod directory. Currently we can only cope
 145     # with sources being in the same directory.
 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     sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
 531 }
 532 sub generate_manifest_readme {
 533   generate_manifest sort {$a->[0] cmp $b->[0]}
 534     ["README.vms", "Notes about installing the VMS port"],
 535       map {["README.$_", $Readmes{$_}]} keys %Readmes;
 536 }
 537
 538 sub generate_roffitall {
 539   (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
 540    "\t\t\\",
 541    map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
 542    "\t\t\\",
 543    map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
 544    "\t\t\\",
 545    map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
 546   )
 547 }
 548
 549 sub generate_descrip_mms_1 {
 550   local $Text::Wrap::columns = 150;
 551   my $count = 0;
 552   my @lines = map {"pod" . $count++ . " = $_"}
 553     split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
 554                      sort keys %Pods, keys %Readmepods);
 555   @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
 556 }
 557
 558 sub generate_descrip_mms_2 {
 559   map {<<"SNIP"}
 560 [.lib.pods]$_.pod : [.pod]$_.pod
 561         \@ If F\$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
 562         Copy/NoConfirm/Log \$(MMS\$SOURCE) [.lib.pods]
 563 SNIP
 564    sort keys %Pods, keys %Readmepods;
 565 }
 566
 567 sub generate_descrip_mms_3 {
 568   map qq{\t- If F\$Search("[.pod]$_").nes."" Then Delete/NoConfirm/Log [.pod]$_;*},
 569     sort keys %Generated, keys %Copies;
 570 }
 571
 572 sub generate_nmake_1 {
 573   # XXX Fix this with File::Spec
 574   (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
 575     sort keys %Readmes),
 576       (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
 577 }
 578
 579 # This doesn't have a trailing newline
 580 sub generate_nmake_2 {
 581   # Spot the special case
 582   local $Text::Wrap::columns = 76;
 583   my $line = wrap ("\t    ", "\t    ",
 584                    join " ", sort keys %Copies, keys %Generated,
 585                                   map {"perl$_.pod"} keys %Readmes);
 586   $line =~ s/$/ \\/mg;
 587   $line;
 588 }
 589
 590 sub generate_pod_mak {
 591   my $variable = shift;
 592   my @lines;
 593   my $line = join "\\\n", "\U$variable = ",
 594     map {"\t$_.$variable\t"} sort keys %Pods;
 595   # Special case
 596   $line =~ s/.*perltoc.html.*\n//m;
 597   $line;
 598 }
 599
 600 sub verify_contiguous {
 601   my ($name, $content, $what) = @_;
 602   my $sections = () = $content =~ m/\0+/g;
 603   croak("$0: $name contains no $what") if $sections < 1;
 604   croak("$0: $name contains discontiguous $what") if $sections > 1;
 605 }
 606
 607 sub do_manifest {
 608   my $name = shift;
 609   my @manifest =
 610     grep {! m!^pod/[^.]+\.pod.*\n!}
 611       grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
 612   # Dictionary order - fold and handle non-word chars as nothing
 613   map  { $_->[0] }
 614   sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
 615   map  { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
 616     @manifest,
 617       &generate_manifest_pod(),
 618         &generate_manifest_readme();
 619 }
 620
 621 sub do_nmake {
 622   my $name = shift;
 623   my $makefile = join '', @_;
 624   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
 625   $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
 626   verify_contiguous($name, $makefile, 'README copies');
 627   # Now remove the other copies that follow
 628   1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
 629   $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
 630
 631   $makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
 632     {"$1\n" . &generate_nmake_2."\n\t    $2"}se;
 633   $makefile;
 634 }
 635
 636 # shut up used only once warning
 637 *do_dmake = *do_dmake = \&do_nmake;
 638
 639 sub do_perlpod {
 640   my $name = shift;
 641   my $pod = join '', @_;
 642
 643   unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
 644                     (?:\s+[a-z]{4,}.*\n #   fooo
 645                     |=head.*\n          # =head foo
 646                     |\s*\n              # blank line
 647                    )+
 648                   }
 649           {$1 . join "", &generate_perlpod}mxe) {
 650     die "$0: Failed to insert amendments in do_perlpod";
 651   }
 652   $pod;
 653 }
 654
 655 sub do_podmak {
 656   my $name = shift;
 657   my $body = join '', @_;
 658   foreach my $variable (qw(pod man html tex)) {
 659     die "$0: could not find $variable in $name"
 660       unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
 661         {"\n" . generate_pod_mak ($variable)}se;
 662   }
 663   $body;
 664 }
 665
 666 sub do_vms {
 667   my $name = shift;
 668   my $makefile = join '', @_;
 669   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
 670   $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
 671   verify_contiguous($name, $makefile, 'pod assignments');
 672   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
 673
 674   die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
 675
 676 # Looking for rules like this
 677 # [.lib.pods]perl.pod : [.pod]perl.pod
 678 #       @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
 679 #       Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
 680
 681   $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
 682                  [^\n]+\n       # Another line
 683                  [^\n]+\Q[.lib.pods]\E\n                # ends [.lib.pods]
 684                     /\0/gsx;
 685   verify_contiguous($name, $makefile, 'copy rules');
 686   $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
 687
 688 # Looking for rules like this:
 689 #       - If F$Search("[.pod]perldelta.pod").nes."" Then Delete/NoConfirm/Log [.pod]perldelta.pod;*
 690   $makefile =~ s!(?:\t- If F\$Search\("\[\.pod\]perl[a-z]+\Q.pod").nes."" Then Delete/NoConfirm/Log [.pod]perl\E[a-z]+\.pod;\*\n)+!\0!sg;
 691   verify_contiguous($name, $makefile, 'delete rules');
 692   $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/se;
 693
 694   $makefile;
 695 }
 696
 697 sub do_unix {
 698   my $name = shift;
 699   my $makefile_SH = join '', @_;
 700   die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
 701
 702   $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*}
 703                    {join ' ', $1, map "pod/$_",
 704                         sort keys %Copies, grep {!/perltoc/} keys %Generated
 705                     }mge;
 706
 707 # pod/perldelta.pod: pod/perl511delta.pod
 708 #       cd pod && $(LNS) perl511delta.pod perldelta.pod
 709
 710   $makefile_SH =~ s!(
 711 pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod
 712         \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod
 713 )+!\0!gm;
 714
 715   verify_contiguous($name, $makefile_SH, 'copy rules');
 716
 717   my @copy_rules = map "
 718 pod/$_: pod/$Copies{$_}
 719         \$(LNS) $Copies{$_} pod/$_
 720 ", keys %Copies;
 721
 722   $makefile_SH =~ s/\0+/join '', @copy_rules/se;
 723   $makefile_SH;
 724
 725 }
 726
 727 # Do stuff
 728
 729 my $built;
 730 while (my ($target, $name) = each %Targets) {
 731   next unless $Build{$target};
 732   $built++;
 733   if ($target eq "toc") {
 734     print "Now processing $name\n" if $Verbose;
 735     &output_perltoc;
 736     print "Finished\n" if $Verbose;
 737     next;
 738   }
 739   print "Now processing $name\n" if $Verbose;
 740   open THING, $name or die "Can't open $name: $!";
 741   my @orig = <THING>;
 742   my $orig = join '', @orig;
 743   close THING;
 744   my @new = do {
 745     no strict 'refs';
 746     &{"do_$target"}($target, @orig);
 747   };
 748   my $new = join '', @new;
 749   if ($new eq $orig) {
 750     print "Was not modified\n" if $Verbose;
 751     next;
 752   }
 753   rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
 754   open THING, ">$name" or die "$0: Can't open $name for writing: $!";
 755   print THING $new or die "$0: print to $name failed: $!";
 756   close THING or die die "$0: close $name failed: $!";
 757 }
 758
 759 warn "$0: was not instructed to build anything\n" unless $built;