[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"),
     # 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,
		       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 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{$_}]}
    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 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;
	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"),
8537f021	36	# TODO: add roffitall
41630250 JH	37	);
	38
	39	{
	40	my @files = keys %Targets;
	41	my $filesopts = join(" \| ", map { "--build-$_" } "all", sort @files);
	42	my $showfiles;
	43	die <<__USAGE__
	44	$0: Usage: $0 [--verbose] [--showfiles] $filesopts
	45	__USAGE__
	46	unless @ARGV
	47	&& GetOptions (verbose => \$Verbose,
	48	showfiles => \$showfiles,
	49	map {+"build-$_", \$Build{$_}} @files, 'all');
	50	# Set them all to true
	51	@Build{@files} = @files if ($Build{all});
	52	if ($showfiles) {
	53	print
	54	join(" ",
	55	sort { lc $a cmp lc $b }
	56	map {
	57	my ($v, $d, $f) = File::Spec->splitpath($_);
	58	my @d;
	59	@d = defined $d ? File::Spec->splitdir($d) : ();
	60	shift @d if @d;
	61	File::Spec->catfile(@d ?
	62	(@d == 1 && $d[0] eq '' ? () : @d)
	63	: "pod", $f);
	64	} @Targets{grep { $_ ne 'all' && $Build{$_} } keys %Build}),
	65	"\n";
	66	exit(0);
	67	}
	68	}
	69
	70	# Don't copy these top level READMEs
	71	%Ignore
	72	= (
41630250 JH	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 AT	85	my ($delta_source, $delta_target);
b0b6bf2b AT	86
41630250 JH	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 JH	92	# it's a heading
41630250 JH	93	my $flags = $1;
8927c9d8	94	$flags =~ tr/h//d;
41630250	95	my %flags = (header => 1);
8927c9d8 NC	96	$flags{toc_omit} = 1 if $flags =~ tr/o//d;
8927c9d8 NC	97	$flags{aux} = 1 if $flags =~ tr/a//d;
41630250 JH	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 AT	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 JH	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 AT	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 JH	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 JH	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 AT	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 JH	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 JH	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 HS	238	my $pod = $file;
be6d6286 HS	239	return if $pod =~ s/pm$/pod/ && -e $pod;
41630250 JH	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
8537f021	277	# OK. Now a lot of ancillary function definitions follow
41630250 JH	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 JH	295
	296	($_= <<"EOPOD2B") =~ s/^\t//gm && output($_);
	297
97f32038 JH	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 JH	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 JH	381	if (s/^=head1 (NAME)\s*/=head2 /) {
	382	$pod = path2modname($ARGV);
	383	unhead1();
	384	output "\n \n\n=head2 ";
	385	$_ = <>;
767650bc NC	386	# Remove svn keyword expansions from the Perl FAQ
767650bc NC	387	s/ \(\$Revision: \d+ \$\)//g;
41630250 JH	388	if ( /^\s*$pod\b/ ) {
	389	s/$pod\.pm/$pod/; # '.pm' in NAME !?
	390	output $_;
	391	} else {
	392	s/^/$pod, /;
	393	output $_;
	394	}
	395	next;
	396	}
	397	if (s/^=head1 (.*)/=item $1/) {
	398	unhead2();
	399	output "=over 4\n\n" unless $inhead1;
	400	$inhead1 = 1;
	401	output $_; nl(); next;
	402	}
	403	if (s/^=head2 (.*)/=item $1/) {
	404	unitem();
	405	output "=over 4\n\n" unless $inhead2;
	406	$inhead2 = 1;
	407	output $_; nl(); next;
	408	}
	409	if (s/^=item ([^=].*)/$1/) {
	410	next if $pod eq 'perldiag';
	411	s/^\s\\s*$// && next;
	412	s/^\s\\s*//;
	413	s/\n/ /g;
	414	s/\s+$//;
	415	next if /^[\d.]+$/;
	416	next if $pod eq 'perlmodlib' && /^ftp:/;
	417	##print "=over 4\n\n" unless $initem;
	418	output ", " if $initem;
	419	$initem = 1;
	420	s/\.$//;
	421	s/^-X\b/-I<X>/;
	422	output $_; next;
	423	}
	424	if (s/^=cut\s*\n//) {
	425	unhead1();
	426	next;
	427	}
	428	}
	429	}
	430
	431	sub unhead1 {
	432	unhead2();
	433	if ($inhead1) {
	434	output "\n\n=back\n\n";
	435	}
	436	$inhead1 = 0;
	437	}
	438
	439	sub unhead2 {
	440	unitem();
	441	if ($inhead2) {
	442	output "\n\n=back\n\n";
	443	}
	444	$inhead2 = 0;
	445	}
	446
	447	sub unitem {
	448	if ($initem) {
	449	output "\n\n";
	450	##print "\n\n=back\n\n";
	451	}
452	$initem = 0;
453	}
454
455	sub nl {
456	output "\n";
457	}
458
459	my $NEWLINE = 0; # how many newlines have we seen recently
460	my $LINE; # what remains to be printed
461
462	sub output ($) {
463	for (split /(\n)/, shift) {
464	if ($_ eq "\n") {
465	if ($LINE) {
466	print OUT wrap('', '', $LINE);
467	$LINE = '';
468	}
469	if (($NEWLINE) < 2) {
470	print OUT;
471	$NEWLINE++;
472	}
473	}
474	elsif (/\S/ && length) {
475	$LINE .= $_;
476	$NEWLINE = 0;
477	}
478	}
479	}
480
481	# End of original buildtoc. From here on are routines to generate new sections
482	# for and inplace edit other files
483
484	sub generate_perlpod {
485	my @output;
486	my $maxlength = 0;
487	foreach (@Master) {
488	my $flags = $_->[0];
489	next if $flags->{aux};
b0b6bf2b	490	next if $flags->{perlpod_omit};
41630250 JH	491
	492	if (@$_ == 2) {
	493	# Heading
	494	push @output, "=head2 $_->[1]\n";
	495	} elsif (@$_ == 3) {
	496	# Section
	497	my $start = " " x (4 + $flags->{indent}) . $_->[1];
	498	$maxlength = length $start if length ($start) > $maxlength;
	499	push @output, [$start, $_->[2]];
	500	} elsif (@$_ == 0) {
	501	# blank line
	502	push @output, "\n";
	503	} else {
	504	die "$0: Illegal length " . scalar @$_;
	505	}
	506	}
	507	# want at least 2 spaces padding
	508	$maxlength += 2;
	509	$maxlength = ($maxlength + 3) & ~3;
	510	# sprintf gives $1.....$2 where ... are spaces:
	511	return unexpand (map {ref $_ ? sprintf "%-${maxlength}s%s\n", @$_ : $_}
	512	@output);
	513	}
	514
	515
	516	sub generate_manifest {
	517	# Annyoingly unexpand doesn't consider it good form to replace a single
	518	# space before a tab with a tab
	519	# Annoyingly (2) it returns read only values.
	520	my @temp = unexpand (map {sprintf "%-32s%s\n", @$_} @_);
	521	map {s/ \t/\t\t/g; $_} @temp;
	522	}
	523	sub generate_manifest_pod {
b0b6bf2b AT	524	generate_manifest map {["pod/$_.pod", $Pods{$_}]}
b0b6bf2b AT	525	grep {!$Copies{"$_.pod"}} sort keys %Pods;
41630250 JH	526	}
	527	sub generate_manifest_readme {
	528	generate_manifest map {["README.$_", $Readmes{$_}]} sort keys %Readmes;
	529	}
	530
	531	sub generate_roffitall {
	532	(map ({"\t\$maindir/$_.1\t\\"}sort keys %Pods),
	533	"\t\t\\",
	534	map ({"\t\$maindir/$_.1\t\\"}sort keys %Aux),
	535	"\t\t\\",
	536	map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
	537	"\t\t\\",
	538	map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
	539	)
	540	}
	541
	542	sub generate_descrip_mms_1 {
	543	local $Text::Wrap::columns = 150;
	544	my $count = 0;
	545	my @lines = map {"pod" . $count++ . " = $_"}
bae7ea06	546	split /\n/, wrap('', '', join " ", map "[.lib.pods]$_.pod",
41630250 JH	547	sort keys %Pods, keys %Readmepods);
	548	@lines, "pod = " . join ' ', map {"\$(pod$_)"} 0 .. $count - 1;
	549	}
	550
	551	sub generate_descrip_mms_2 {
ab1db26f	552	map {sprintf <<'SNIP', $_, $_ eq 'perlvms' ? 'vms' : 'pod', $_}
bae7ea06 NC	553	[.lib.pods]%s.pod : [.%s]%s.pod
	554	@ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
	555	Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
41630250 JH	556	SNIP
	557	sort keys %Pods, keys %Readmepods;
	558	}
	559
	560	sub generate_nmake_1 {
b0b6bf2b AT	561	# XXX Fix this with File::Spec
	562	(map {sprintf "\tcopy ..\\README.%-8s ..\\pod\\perl$_.pod\n", $_}
	563	sort keys %Readmes),
	564	(map {"\tcopy ..\\pod\\$Copies{$_} ..\\pod\\$_\n"} sort keys %Copies);
41630250 JH	565	}
	566
	567	# This doesn't have a trailing newline
	568	sub generate_nmake_2 {
	569	# Spot the special case
	570	local $Text::Wrap::columns = 76;
	571	my $line = wrap ("\t ", "\t ",
b0b6bf2b AT	572	join " ", sort keys %Copies,
b0b6bf2b AT	573	map {"perl$_.pod"} "vms", keys %Readmes);
41630250 JH	574	$line =~ s/$/ \\/mg;
	575	$line;
	576	}
	577
	578	sub generate_pod_mak {
	579	my $variable = shift;
	580	my @lines;
	581	my $line = join "\\\n", "\U$variable = ",
	582	map {"\t$_.$variable\t"} sort keys %Pods;
	583	# Special case
	584	$line =~ s/.perltoc.html.\n//m;
	585	$line;
	586	}
	587
	588	sub do_manifest {
	589	my $name = shift;
	590	my @manifest =
	591	grep {! m!^pod/[^.]+\.pod.*\n!}
	592	grep {! m!^README\.(\S+)! \|\| $Ignore{$1}} @_;
	593	# Dictionary order - fold and handle non-word chars as nothing
	594	map { $_->[0] }
	595	sort { $a->[1] cmp $b->[1] \|\| $a->[0] cmp $b->[0] }
6578b326	596	map { my $f = lc $_; $f =~ s/[^a-z0-9\s]//g; [ $_, $f ] }
41630250 JH	597	@manifest,
	598	&generate_manifest_pod(),
	599	&generate_manifest_readme();
	600	}
	601
	602	sub do_nmake {
	603	my $name = shift;
	604	my $makefile = join '', @_;
	605	die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
	606	$makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
	607	my $sections = () = $makefile =~ m/\0+/g;
	608	die "$0: $name contains no README copies" if $sections < 1;
	609	die "$0: $name contains discontiguous README copies" if $sections > 1;
b0b6bf2b AT	610	# Now remove the other copies that follow
	611	1 while $makefile =~ s/\0\tcopy .*\n/\0/gm;
	612	$makefile =~ s/\0+/join ("", &generate_nmake_1)/se;
41630250	613
b0b6bf2b	614	$makefile =~ s{(del /f [^\n]+checkpods[^\n]+).*?(pod2html)}
41630250 JH	615	{"$1\n" . &generate_nmake_2."\n\t $2"}se;
	616	$makefile;
	617	}
	618
	619	# shut up used only once warning
	620	do_dmake = do_dmake = \&do_nmake;
	621
	622	sub do_perlpod {
	623	my $name = shift;
	624	my $pod = join '', @_;
	625
	626	unless ($pod =~ s{(For\ ease\ of\ access,\ .*\n)
	627	(?:\s+[a-z]{4,}.*\n # fooo
	628	\|=head.*\n # =head foo
	629	\|\s*\n # blank line
	630	)+
	631	}
	632	{$1 . join "", &generate_perlpod}mxe) {
8537f021	633	die "$0: Failed to insert amendments in do_perlpod";
41630250 JH	634	}
	635	$pod;
	636	}
	637
	638	sub do_podmak {
	639	my $name = shift;
	640	my $body = join '', @_;
d525b9bc	641	foreach my $variable (qw(pod man html tex)) {
41630250 JH	642	die "$0: could not find $variable in $name"
	643	unless $body =~ s{\n\U$variable\E = (?:[^\n]\\\n)[^\n]*}
	644	{"\n" . generate_pod_mak ($variable)}se;
	645	}
	646	$body;
	647	}
	648
	649	sub do_vms {
	650	my $name = shift;
	651	my $makefile = join '', @_;
	652	die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
	653	$makefile =~ s/\npod\d* =[^\n]*/\0/gs;
	654	my $sections = () = $makefile =~ m/\0+/g;
	655	die "$0: $name contains no pod assignments" if $sections < 1;
	656	die "$0: $name contains $sections discontigous pod assignments"
	657	if $sections > 1;
	658	$makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se;
	659
	660	die "$0: $name contains NUL bytes" if $makefile =~ /\0/;
	661
	662	# Looking for rules like this
bae7ea06 NC	663	# [.lib.pods]perl.pod : [.pod]perl.pod
	664	# @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods]
	665	# Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods]
41630250	666
bae7ea06	667	$makefile =~ s/\n\Q[.lib.pods]\Eperl[^\n\.]*\.pod[^\n]+\n
41630250	668	[^\n]+\n # Another line
bae7ea06	669	[^\n]+\Q[.lib.pods]\E\n # ends [.lib.pods]
41630250 JH	670	/\0/gsx;
	671	$sections = () = $makefile =~ m/\0+/g;
	672	die "$0: $name contains no copy rules" if $sections < 1;
	673	die "$0: $name contains $sections discontigous copy rules"
	674	if $sections > 1;
	675	$makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se;
	676	$makefile;
	677	}
	678
0dfdcd8a NC	679	sub do_unix {
	680	my $name = shift;
	681	my $makefile_SH = join '', @_;
	682	die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/;
	683
	684	$makefile_SH =~ s/\n\s+-\@test -f \S+ && cd pod && \$\(LNS\) \S+ \S+ && cd \.\. && echo "\S+" >> extra.pods \# See buildtoc\n/\0/gm;
	685
	686	my $sections = () = $makefile_SH =~ m/\0+/g;
	687
	688	die "$0: $name contains no copy rules" if $sections < 1;
	689	die "$0: $name contains $sections discontigous copy rules"
	690	if $sections > 1;
	691
	692	my @copy_rules = map "\t-\@test -f pod/$Copies{$_} && cd pod && \$(LNS) $Copies{$_} $_ && cd .. && echo \"pod/$_\" >> extra.pods # See buildtoc",
	693	keys %Copies;
	694
	695	$makefile_SH =~ s/\0+/join "\n", '', @copy_rules, ''/se;
	696	$makefile_SH;
	697
	698	}
	699
41630250 JH	700	# Do stuff
	701
	702	my $built;
	703	while (my ($target, $name) = each %Targets) {
	704	next unless $Build{$target};
	705	$built++;
	706	if ($target eq "toc") {
671313d0	707	print "Now processing $name\n" if $Verbose;
41630250	708	&output_perltoc;
671313d0	709	print "Finished\n" if $Verbose;
41630250 JH	710	next;
	711	}
	712	print "Now processing $name\n" if $Verbose;
	713	open THING, $name or die "Can't open $name: $!";
	714	my @orig = <THING>;
	715	my $orig = join '', @orig;
	716	close THING;
	717	my @new = do {
	718	no strict 'refs';
	719	&{"do_$target"}($target, @orig);
	720	};
	721	my $new = join '', @new;
	722	if ($new eq $orig) {
	723	print "Was not modified\n" if $Verbose;
	724	next;
	725	}
	726	rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!";
	727	open THING, ">$name" or die "$0: Can't open $name for writing: $!";
	728	print THING $new or die "$0: print to $name failed: $!";
	729	close THING or die die "$0: close $name failed: $!";
	730	}
	731
	732	warn "$0: was not instructed to build anything\n" unless $built;