pod/buildtoc

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