[p5sagit/p5-mst-13.2.git] / pod / buildtoc

#!/usr/bin/perl -w

use strict;
use vars qw($masterpodfile %Build %Targets $Verbose $Up %Ignore
	    @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules
	    %Copies);
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
# --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"),
    );

{
  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,
		       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
  = (
     Y2K => 1,
     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";
    }

    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};
    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};
  }
  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";
      }
    }
  }

  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 ancillay 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 ";
	    $_ = <>;
	    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{$_}]}
    grep {!$Copies{"$_.pod"}} sort 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.pod]$_.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.pod]%s.pod : [.%s]%s.pod
	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
	Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
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]+checkpods[^\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 ammendments 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.pod]perl.pod : [.pod]perl.pod
#	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
#	Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]

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