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