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