[perl5.git] / pod / buildtoc

#!/usr/bin/perl -w

use strict;
use vars qw($masterpodfile %Build %Targets $Verbose $Quiet $Up %Ignore
	    @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
	    %Copies %Generated);
use File::Spec;
use File::Find;
use FindBin;
use Text::Tabs;
use Text::Wrap;
use Getopt::Long;

no locale;

$Up = File::Spec->updir;
$masterpodfile = File::Spec->catdir($Up, "pod.lst");

# Generate any/all of these files
# --verbose gives slightly more output
# --quiet suppresses routine warnings
# --build-all tries to build everything
# --build-foo updates foo as follows
# --showfiles shows the files to be changed

%Targets
  = (
     toc => "perltoc.pod",
     manifest => File::Spec->catdir($Up, "MANIFEST"),
     perlpod => "perl.pod",
     vms => File::Spec->catdir($Up, "vms", "descrip_mms.template"),
     nmake => File::Spec->catdir($Up, "win32", "Makefile"),
     dmake => File::Spec->catdir($Up, "win32", "makefile.mk"),
     podmak => File::Spec->catdir($Up, "win32", "pod.mak"),
     # plan9 =>  File::Spec->catdir($Up, "plan9", "mkfile"),
     unix => File::Spec->catdir($Up, "Makefile.SH"),
     # TODO: add roffitall
    );

{
  my @files = keys %Targets;
  my $filesopts = join(" | ", map { "--build-$_" } "all", sort @files);
  my $showfiles;
  die <<__USAGE__
$0: Usage: $0 [--verbose] [--showfiles] $filesopts
__USAGE__
  unless @ARGV
	&& GetOptions (verbose => \$Verbose,
		       quiet => \$Quiet,
		       showfiles => \$showfiles,
		       map {+"build-$_", \$Build{$_}} @files, 'all');
  # Set them all to true
  @Build{@files} = @files if ($Build{all});
  if ($showfiles) {
      print
	  join(" ",
	       sort { lc $a cmp lc $b }
	       map {
		   my ($v, $d, $f) = File::Spec->splitpath($_);
		   my @d;
		   @d = defined $d ? File::Spec->splitdir($d) : ();
		   shift @d if @d;
		   File::Spec->catfile(@d ?
				       (@d == 1 && $d[0] eq '' ? () : @d)
				       : "pod", $f);
	       } @Targets{grep { $_ ne 'all' && $Build{$_} } keys %Build}),
          "\n";
      exit(0);
  }
}

# Don't copy these top level READMEs
%Ignore
  = (
     micro => 1,
#     vms => 1,
     );

if ($Verbose) {
  print "I'm building $_\n" foreach grep {$Build{$_}} keys %Build;
}

chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!";

open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!";

my ($delta_source, $delta_target);

foreach (<MASTER>) {
  next if /^\#/;

  # At least one upper case letter somewhere in the first group
  if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
    # it's a heading
    my $flags = $1;
    $flags =~ tr/h//d;
    my %flags = (header => 1);
    $flags{toc_omit} = 1 if $flags =~ tr/o//d;
    $flags{aux} = 1 if $flags =~ tr/a//d;
    die "$0: Unknown flag found in heading line: $_" if length $flags;
    push @Master, [\%flags, $2];

  } elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
    # it's a section
    my ($flags, $filename, $desc) = ($1, $2, $3);

    my %flags = (indent => 0);
    $flags{indent} = $1 if $flags =~ s/(\d+)//;
    $flags{toc_omit} = 1 if $flags =~ tr/o//d; 
    $flags{aux} = 1 if $flags =~ tr/a//d;

    if ($flags =~ tr/D//d) {
      $flags{perlpod_omit} = 1;
      $delta_source = "$filename.pod";
    }
    if ($flags =~ tr/d//d) {
      $flags{manifest_omit} = 1;
      $delta_target = "$filename.pod";
    }
    $Generated{"$filename.pod"}++ if $flags =~ tr/g//d;

    if ($flags =~ tr/r//d) {
      my $readme = $filename;
      $readme =~ s/^perl//;
      $Readmepods{$filename} = $Readmes{$readme} = $desc;
      $flags{readme} = 1;
    } elsif ($flags{aux}) {
      $Aux{$filename} = $desc;
    } else {
      $Pods{$filename} = $desc;
    }
    die "$0: Unknown flag found in section line: $_" if length $flags;
    push @Master, [\%flags, $filename, $desc];
  } elsif (/^$/) {
    push @Master, undef;
  } else {
    die "$0: Malformed line: $_" if $1 =~ tr/A-Z//;
  }
}
if (defined $delta_source) {
  if (defined $delta_target) {
    # This way round so that keys can act as a MANIFEST skip list
    # Targets will aways be in the pod directory. Currently we can only cope
    # with sources being in the same directory. Fix this and do perlvms.pod
    # with this?
    $Copies{$delta_target} = $delta_source;
  } else {
    die "$0: delta source defined but not target";
  }
} elsif (defined $delta_target) {
  die "$0: delta target defined but not target";
}

close MASTER;

# Sanity cross check
{
  my (%disk_pods, @disk_pods);
  my (@manipods, %manipods);
  my (@manireadmes, %manireadmes);
  my (@perlpods, %perlpods);
  my (%our_pods);
  my (%sources);

  # Convert these to a list of filenames.
  foreach (keys %Pods, keys %Readmepods) {
    $our_pods{"$_.pod"}++;
  }

  # None of these filenames will be boolean false
  @disk_pods = glob("*.pod");
  @disk_pods{@disk_pods} = @disk_pods;

  # Things we copy from won't be in perl.pod
  # Things we copy to won't be in MANIFEST
  @sources{values %Copies} = ();

  open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
  while (<MANI>) {
    if (m!^pod/([^.]+\.pod)\s+!i) {
      push @manipods, $1;
    } elsif (m!^README\.(\S+)\s+!i) {
      next if $Ignore{$1};
      push @manireadmes, "perl$1.pod";
    }
  }
  close(MANI);
  @manipods{@manipods} = @manipods;
  @manireadmes{@manireadmes} = @manireadmes;

  open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
  while (<PERLPOD>) {
    if (/^For ease of access, /../^\(If you're intending /) {
      if (/^\s+(perl\S*)\s+\w/) {
	push @perlpods, "$1.pod";
      }
    }
  }
  close(PERLPOD);
  die "$0: could not find the pod listing of perl.pod\n"
    unless @perlpods;
  @perlpods{@perlpods} = @perlpods;

  foreach my $i (sort keys %disk_pods) {
    warn "$0: $i exists but is unknown by buildtoc\n"
      unless $our_pods{$i};
    warn "$0: $i exists but is unknown by ../MANIFEST\n"
      if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i};
    warn "$0: $i exists but is unknown by perl.pod\n"
	if !$perlpods{$i} && !exists $sources{$i};
  }
  foreach my $i (sort keys %our_pods) {
    warn "$0: $i is known by buildtoc but does not exist\n"
      unless $disk_pods{$i};
  }
  foreach my $i (sort keys %manipods) {
    warn "$0: $i is known by ../MANIFEST but does not exist\n"
      unless $disk_pods{$i};
    warn "$0: $i is known by ../MANIFEST but is marked as generated\n"
      if $Generated{$i};
  }
  foreach my $i (sort keys %perlpods) {
    warn "$0: $i is known by perl.pod but does not exist\n"
      unless $disk_pods{$i};
  }
}

# Find all the mdoules
{
  my @modpods;
  find \&getpods => qw(../lib ../ext);

  sub getpods {
    if (/\.p(od|m)$/) {
      my $file = $File::Find::name;
      return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
      return if $file =~ m!(?:^|/)t/!;
      return if $file =~ m!lib/Attribute/Handlers/demo/!;
      return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
      return if $file =~ m!lib/Math/BigInt/t/!;
      return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
      return if $file =~ m!XS/(?:APItest|Typemap)!;
      my $pod = $file;
      return if $pod =~ s/pm$/pod/ && -e $pod;
      die "$0: tut $File::Find::name" if $file =~ /TUT/;
      unless (open (F, "< $_\0")) {
	warn "$0: bogus <$file>: $!";
	system "ls", "-l", $file;
      }
      else {
	my $line;
	while ($line = <F>) {
	  if ($line =~ /^=head1\s+NAME\b/) {
	    push @modpods, $file;
	    #warn "GOOD $file\n";
	    return;
	  }
	}
	warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet;
      }
    }
  }

  die "$0: no pods" unless @modpods;

  my %done;
  for (@modpods) {
    #($name) = /(\w+)\.p(m|od)$/;
    my $name = path2modname($_);
    if ($name =~ /^[a-z]/) {
      $Pragmata{$name} = $_;
    } else {
      if ($done{$name}++) {
	# warn "already did $_\n";
	next;
      }
      $Modules{$name} = $_;
    }
  }
}

# OK. Now a lot of ancillary function definitions follow
# Main program returns at "Do stuff"

sub path2modname {
    local $_ = shift;
    s/\.p(m|od)$//;
    s-.*?/(lib|ext)/--;
    s-/-::-g;
    s/(\w+)::\1/$1/;
    return $_;
}

sub output ($);

sub output_perltoc {
  open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";

  local $/ = '';

  ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);

	# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
	# This file is autogenerated by buildtoc from all the other pods.
	# Edit those files and run buildtoc --build-toc to effect changes.

	=head1 NAME

	perltoc - perl documentation table of contents

	=head1 DESCRIPTION

	This page provides a brief table of contents for the rest of the Perl
	documentation set.  It is meant to be scanned quickly or grepped
	through to locate the proper section you're looking for.

	=head1 BASIC DOCUMENTATION

EOPOD2B
#' make emacs happy

  # All the things in the master list that happen to be pod filenames
  podset(map {"$_->[1].pod"} grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master);


  ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);


	=head1 PRAGMA DOCUMENTATION

EOPOD2B

  podset(sort values %Pragmata);

  ($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);


	=head1 MODULE DOCUMENTATION

EOPOD2B

  podset( @Modules{ sort keys %Modules } );

  $_= <<"EOPOD2B";


	=head1 AUXILIARY DOCUMENTATION

	Here should be listed all the extra programs' documentation, but they
	don't all have manual pages yet:

	=over 4

EOPOD2B

  $_ .=  join "\n", map {"\t=item $_\n"} sort keys %Aux;
  $_ .= <<"EOPOD2B" ;

	=back

	=head1 AUTHOR

	Larry Wall <F<larry\@wall.org>>, with the help of oodles
	of other folks.


EOPOD2B

  s/^\t//gm;
  output $_;
  output "\n";                    # flush $LINE
}

# Below are all the auxiliary routines for generating perltoc.pod

my ($inhead1, $inhead2, $initem);

sub podset {
    local @ARGV = @_;
    my $pod;

    while(<>) {
	tr/\015//d;
	if (s/^=head1 (NAME)\s*/=head2 /) {
	    $pod = path2modname($ARGV);
	    unhead1();
	    output "\n \n\n=head2 ";
	    $_ = <>;
	    # Remove svn keyword expansions from the Perl FAQ
	    s/ \(\$Revision: \d+ \$\)//g;
	    if ( /^\s*$pod\b/ ) {
		s/$pod\.pm/$pod/;       # '.pm' in NAME !?
		output $_;
	    } else {
		s/^/$pod, /;
		output $_;
	    }
	    next;
	}
	if (s/^=head1 (.*)/=item $1/) {
	    unhead2();
	    output "=over 4\n\n" unless $inhead1;
	    $inhead1 = 1;
	    output $_; nl(); next;
	}
	if (s/^=head2 (.*)/=item $1/) {
	    unitem();
	    output "=over 4\n\n" unless $inhead2;
	    $inhead2 = 1;
	    output $_; nl(); next;
	}
	if (s/^=item ([^=].*)/$1/) {
	    next if $pod eq 'perldiag';
	    s/^\s*\*\s*$// && next;
	    s/^\s*\*\s*//;
	    s/\n/ /g;
	    s/\s+$//;
	    next if /^[\d.]+$/;
	    next if $pod eq 'perlmodlib' && /^ftp:/;
	    ##print "=over 4\n\n" unless $initem;
	    output ", " if $initem;
	    $initem = 1;
	    s/\.$//;
	    s/^-X\b/-I<X>/;
	    output $_; next;
	}
	if (s/^=cut\s*\n//) {
	    unhead1();
	    next;
	}
    }
}

sub unhead1 {
    unhead2();
    if ($inhead1) {
	output "\n\n=back\n\n";
    }
    $inhead1 = 0;
}

sub unhead2 {
    unitem();
    if ($inhead2) {
	output "\n\n=back\n\n";
    }
    $inhead2 = 0;
}

sub unitem {
    if ($initem) {
	output "\n\n";
	##print "\n\n=back\n\n";
    }
    $initem = 0;
}

sub nl {
    output "\n";
}

my $NEWLINE = 0;	# how many newlines have we seen recently
my $LINE;		# what remains to be printed

sub output ($) {
    for (split /(\n)/, shift) {
	if ($_ eq "\n") {
	    if ($LINE) {
		print OUT wrap('', '', $LINE);
		$LINE = '';
	    }
	    if (($NEWLINE) < 2) {
		print OUT;
		$NEWLINE++;
	    }
	}
	elsif (/\S/ && length) {
	    $LINE .= $_;
	    $NEWLINE = 0;
	}
    }
}

# End of original buildtoc. From here on are routines to generate new sections
# for and inplace edit other files

sub generate_perlpod {
  my @output;
  my $maxlength = 0;
  foreach (@Master) {
    my $flags = $_->[0];
    next if $flags->{aux};
    next if $flags->{perlpod_omit};

    if (@$_ == 2) {
      # Heading
      push @output, "=head2 $_->[1]\n";
    } elsif (@$_ == 3) {
      # Section
      my $start = " " x (4 + $flags->{indent}) . $_->[1];
      $maxlength = length $start if length ($start) > $maxlength;
      push @output, [$start, $_->[2]];
    } elsif (@$_ == 0) {
      # blank line
      push @output, "\n";
    } else {
      die "$0: Illegal length " . scalar @$_;
    }
  }
  # want at least 2 spaces padding
  $maxlength += 2;
  $maxlength = ($maxlength + 3) & ~3;
  # sprintf gives $1.....$2 where ... are spaces:
  return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
		   @output);
}


sub generate_manifest {
  # Annyoingly unexpand doesn't consider it good form to replace a single
  # space before a tab with a tab
  # Annoyingly (2) it returns read only values.
  my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
  map {s/ \t/\t\t/g; $_} @temp;
}
sub generate_manifest_pod {
  generate_manifest map {["pod/$_.pod", $Pods{$_}]}
    sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
}
sub generate_manifest_readme {
  generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
}

sub generate_roffitall {
  (map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
   "\t\t\\",
   map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
   "\t\t\\",
   map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
   "\t\t\\",
   map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
  )
}

sub generate_descrip_mms_1 {
  local $Text::Wrap::columns = 150;
  my $count = 0;
  my @lines = map {"pod" . $count++ . " = $_"}
    split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
		     sort keys %Pods, keys %Readmepods);
  @lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
}

sub generate_descrip_mms_2 {
  map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
[.lib.pods]%s.pod : [.%s]%s.pod
	@ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
	Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
SNIP
   sort keys %Pods, keys %Readmepods;
}

sub generate_nmake_1 {
  # XXX Fix this with File::Spec
  (map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
    sort keys %Readmes),
      (map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
}

# This doesn't have a trailing newline
sub generate_nmake_2 {
  # Spot the special case
  local $Text::Wrap::columns = 76;
  my $line = wrap ("\t    ", "\t    ",
		   join " ", sort keys %Copies,
				  map {"perl$_.pod"} "vms", keys %Readmes);
  $line =~ s/$/ \\/mg;
  $line;
}

sub generate_pod_mak {
  my $variable = shift;
  my @lines;
  my $line = join "\\\n", "\U$variable = ",
    map {"\t$_.$variable\t"} sort keys %Pods;
  # Special case
  $line =~ s/.*perltoc.html.*\n//m;
  $line;
}

sub do_manifest {
  my $name = shift;
  my @manifest =
    grep {! m!^pod/[^.]+\.pod.*\n!}
      grep {! m!^README\.(\S+)! || $Ignore{$1}} @_;
  # Dictionary order - fold and handle non-word chars as nothing
  map  { $_->[0] }
  sort { $a->[1] cmp $b->[1] || $a->[0] cmp $b->[0] }
  map  { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
    @manifest,
      &generate_manifest_pod(),
	&generate_manifest_readme();
}

sub do_nmake {
  my $name = shift;
  my $makefile = join '', @_;
  die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
  $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
  my $sections = () = $makefile =~ m/\0+/g;
  die "$0: $name contains no README copies" if $sections < 1;
  die "$0: $name contains discontiguous README copies" if $sections > 1;
  # Now remove the other copies that follow
  1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
  $makefile =~ s/\0+/join ("", &generate_nmake_1)/se;

  $makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
    {"$1\n" . &generate_nmake_2."\n\t    $2"}se;
  $makefile;
}

# shut up used only once warning
*do_dmake = *do_dmake = \&do_nmake;

sub do_perlpod {
  my $name = shift;
  my $pod = join '', @_;

  unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
		    (?:\s+[a-z]{4,}.*\n	#   fooo
		    |=head.*\n		# =head foo
		    |\s*\n		# blank line
		   )+
		  }
	  {$1 . join "", &generate_perlpod}mxe) {
    die "$0: Failed to insert amendments in do_perlpod";
  }
  $pod;
}

sub do_podmak {
  my $name = shift;
  my $body = join '', @_;
  foreach my $variable (qw(pod man html tex)) {
    die "$0: could not find $variable in $name"
      unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
	{"\n" . generate_pod_mak ($variable)}se;
  }
  $body;
}

sub do_vms {
  my $name = shift;
  my $makefile = join '', @_;
  die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
  $makefile =~ s/\npod\d* =[^\n]*/\0/gs;
  my $sections = () = $makefile =~ m/\0+/g;
  die "$0: $name contains no pod assignments" if $sections < 1;
  die "$0: $name contains $sections discontigous pod assignments"
    if $sections > 1;
  $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;

  die "$0: $name contains NUL bytes" if $makefile =~ /\0/;

# Looking for rules like this
# [.lib.pods]perl.pod : [.pod]perl.pod
#	@ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
#	Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]

  $makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
		 [^\n]+\n	# Another line
		 [^\n]+\Q[.lib.pods]\E\n		# ends [.lib.pods]
		    /\0/gsx;
  $sections = () = $makefile =~ m/\0+/g;
  die "$0: $name contains no copy rules" if $sections < 1;
  die "$0: $name contains $sections discontigous copy rules"
    if $sections > 1;
  $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
  $makefile;
}

sub do_unix {
  my $name = shift;
  my $makefile_SH = join '', @_;
  die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;

  $makefile_SH =~ s/\n\s+-\@test -f \S+ && cd pod && \$\(LNS\) \S+ \S+ && cd \.\. && echo "\S+" >> extra.pods \# See buildtoc\n/\0/gm;

  my $sections = () = $makefile_SH =~ m/\0+/g;

  die "$0: $name contains no copy rules" if $sections < 1;
  die "$0: $name contains $sections discontigous copy rules"
    if $sections > 1;

  my @copy_rules = map "\t-\@test -f pod/$Copies{$_} && cd pod && \$(LNS) $Copies{$_} $_ && cd .. && echo \"pod/$_\" >> extra.pods # See buildtoc",
    keys %Copies;

  $makefile_SH =~ s/\0+/join "\n", '', @copy_rules, ''/se;
  $makefile_SH;

}

# Do stuff

my $built;
while (my ($target, $name) = each %Targets) {
  next unless $Build{$target};
  $built++;
  if ($target eq "toc") {
    print "Now processing $name\n" if $Verbose;
    &output_perltoc;
    print "Finished\n" if $Verbose;
    next;
  }
  print "Now processing $name\n" if $Verbose;
  open THING, $name or die "Can't open $name: $!";
  my @orig = <THING>;
  my $orig = join '', @orig;
  close THING;
  my @new = do {
    no strict 'refs';
    &{"do_$target"}($target, @orig);
  };
  my $new = join '', @new;
  if ($new eq $orig) {
    print "Was not modified\n" if $Verbose;
    next;
  }
  rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
  open THING, ">$name" or die "$0: Can't open $name for writing: $!";
  print THING $new or die "$0: print to $name failed: $!";
  close THING or die die "$0: close $name failed: $!";
}

warn "$0: was not instructed to build anything\n" unless $built;
Commit	Line	Data
41630250 JH	1	#!/usr/bin/perl -w
	2
	3	use strict;
d092c3cd	4	use vars qw($masterpodfile %Build %Targets $Verbose $Quiet $Up %Ignore
b0b6bf2b	5	@Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
344af494	6	%Copies %Generated);
41630250 JH	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
d092c3cd	21	# --quiet suppresses routine warnings
41630250 JH	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"),
0dfdcd8a	36	unix => File::Spec->catdir($Up, "Makefile.SH"),
8537f021	37	# TODO: add roffitall
41630250 JH	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,
d092c3cd	49	quiet => \$Quiet,
41630250 JH	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	= (
41630250 JH	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
b0b6bf2b AT	87	my ($delta_source, $delta_target);
b0b6bf2b AT	88
41630250 JH	89	foreach (<MASTER>) {
	90	next if /^\#/;
	91
	92	# At least one upper case letter somewhere in the first group
8927c9d8	93	if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
41630250 JH	94	# it's a heading
41630250 JH	95	my $flags = $1;
8927c9d8	96	$flags =~ tr/h//d;
41630250	97	my %flags = (header => 1);
8927c9d8 NC	98	$flags{toc_omit} = 1 if $flags =~ tr/o//d;
8927c9d8 NC	99	$flags{aux} = 1 if $flags =~ tr/a//d;
41630250 JH	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+)//;
b0b6bf2b	109	$flags{toc_omit} = 1 if $flags =~ tr/o//d;
41630250	110	$flags{aux} = 1 if $flags =~ tr/a//d;
b0b6bf2b AT	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	}
344af494	120	$Generated{"$filename.pod"}++ if $flags =~ tr/g//d;
b0b6bf2b	121
41630250 JH	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	}
b0b6bf2b AT	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	}
41630250 JH	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);
b0b6bf2b	163	my (%sources);
41630250 JH	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
b0b6bf2b AT	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
41630250 JH	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"
344af494	208	if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i};
41630250	209	warn "$0: $i exists but is unknown by perl.pod\n"
b0b6bf2b	210	if !$perlpods{$i} && !exists $sources{$i};
41630250 JH	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};
344af494 NC	219	warn "$0: $i is known by ../MANIFEST but is marked as generated\n"
344af494 NC	220	if $Generated{$i};
41630250 JH	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)!;
be6d6286 HS	243	my $pod = $file;
be6d6286 HS	244	return if $pod =~ s/pm$/pod/ && -e $pod;
41630250 JH	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	}
d092c3cd	259	warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet;
41630250 JH	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
8537f021	282	# OK. Now a lot of ancillary function definitions follow
41630250 JH	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
671313d0	299	local $/ = '';
41630250 JH	300
	301	($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
	302
97f32038 JH	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.
97f32038	306
41630250 JH	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(<>) {
16114dde	385	tr/\015//d;
41630250 JH	386	if (s/^=head1 (NAME)\s*/=head2 /) {
	387	$pod = path2modname($ARGV);
	388	unhead1();
	389	output "\n \n\n=head2 ";
	390	$_ = <>;
767650bc NC	391	# Remove svn keyword expansions from the Perl FAQ
767650bc NC	392	s/ \(\$Revision: \d+ \$\)//g;
41630250 JH	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};
b0b6bf2b	495	next if $flags->{perlpod_omit};
41630250 JH	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 {
b0b6bf2b	529	generate_manifest map {["pod/$_.pod", $Pods{$_}]}
3dc608da	530	sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods;
41630250 JH	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++ . " = $_"}
bae7ea06	551	split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
41630250 JH	552	sort keys %Pods, keys %Readmepods);
	553	@lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
	554	}
	555
	556	sub generate_descrip_mms_2 {
ab1db26f	557	map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
bae7ea06 NC	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]
41630250 JH	561	SNIP
	562	sort keys %Pods, keys %Readmepods;
	563	}
	564
	565	sub generate_nmake_1 {
b0b6bf2b AT	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);
41630250 JH	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 ",
b0b6bf2b AT	577	join " ", sort keys %Copies,
b0b6bf2b AT	578	map {"perl$_.pod"} "vms", keys %Readmes);
41630250 JH	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] }
6578b326	601	map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
41630250 JH	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;
b0b6bf2b AT	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;
41630250	618
94442a1e	619	$makefile =~ s{(del /f [^\n]+podchecker[^\n]+).*?(pod2html)}
41630250 JH	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) {
8537f021	638	die "$0: Failed to insert amendments in do_perlpod";
41630250 JH	639	}
	640	$pod;
	641	}
	642
	643	sub do_podmak {
	644	my $name = shift;
	645	my $body = join '', @_;
d525b9bc	646	foreach my $variable (qw(pod man html tex)) {
41630250 JH	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
bae7ea06 NC	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]
41630250	671
bae7ea06	672	$makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
41630250	673	[^\n]+\n # Another line
bae7ea06	674	[^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods]
41630250 JH	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
0dfdcd8a NC	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
41630250 JH	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") {
671313d0	712	print "Now processing $name\n" if $Verbose;
41630250	713	&output_perltoc;
671313d0	714	print "Finished\n" if $Verbose;
41630250 JH	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;