The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

our ($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;

$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 => "kurilatoc.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
    );

do {
  my @files = keys %Targets;
  my $filesopts = join(" | ", map { "--build-$_" }, @( "all", < sort @files));
  my $showfiles;
  die <<__USAGE__
$^PROGRAM_NAME: Usage: $^PROGRAM_NAME [--verbose] [--showfiles] $filesopts
__USAGE__
  unless (nelems @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 (nelems @d);
		   File::Spec->catfile((nelems @d)
				       ?? ((nelems @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 "$^PROGRAM_NAME: Can't chdir $FindBin::Bin: $^OS_ERROR";

open my $master, "<", $masterpodfile or die "$^PROGRAM_NAME: Can't open $masterpodfile: $^OS_ERROR";

my ($delta_source, $delta_target);

foreach (@( ~< *$master)) {
  next if m/^\#/;

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

  } elsif (m/^(\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 =~ s/o//g; 
    %flags{+aux} = 1 if $flags =~ s/a//g;

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

    if ($flags =~ s/r//g) {
      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 "$^PROGRAM_NAME: Unknown flag found in section line: $_" if length $flags;
    push @Master, \@(\%flags, $filename, $desc);
  } elsif (m/^$/) {
    push @Master, undef;
  } else {
    die "$^PROGRAM_NAME: Malformed line: $_" if $1 =~ m/[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 "$^PROGRAM_NAME: delta source defined but not target";
  }
} elsif (defined $delta_target) {
  die "$^PROGRAM_NAME: delta target defined but not target";
}

close $master;

# Sanity cross check
do {
  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(my $mani, "<", "../MANIFEST") || die "$^PROGRAM_NAME: opening ../MANIFEST failed: $^OS_ERROR";
  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;

  my $in_perlpod;
  open(my $perlpod, "<", "perl.pod") || die "$^PROGRAM_NAME: opening perl.pod failed: $^OS_ERROR\n";
  while ( ~< *$perlpod) {
    $in_perlpod ||= m/^For ease of access/;
    $in_perlpod &&= ! m/^\(If you're intending /;
    if ($in_perlpod) {
      if (m/^\s+((?:perl|kurila)\S*)\s+\w/) {
	push @perlpods, "$1.pod";
      }
    }
  }
  close($perlpod);
  die "$^PROGRAM_NAME: could not find the pod listing of perl.pod\n"
    unless (nelems @perlpods);
  %perlpods{[@perlpods]} = @perlpods;

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

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

  sub getpods {
    if (m/\.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!/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 "$^PROGRAM_NAME: tut $File::Find::name" if $file =~ m/TUT/;
      unless (open (my $f, "<", "$_\0")) {
	warn "$^PROGRAM_NAME: bogus <$file>: $^OS_ERROR";
	system "ls", "-l", $file;
      }
      else {
	my $line;
	while ($line = ~< *$f) {
	  if ($line =~ m/^=head1\s+NAME\b/) {
	    push @modpods, $file;
	    #warn "GOOD $file\n";
	    return;
	  }
	}
	warn "$^PROGRAM_NAME: $file: cannot find =head1 NAME\n";
      }
    }
  }

  die "$^PROGRAM_NAME: no pods" unless (nelems @modpods);

  my %done;
  for ( @modpods) {
    #($name) = /(\w+)\.p(m|od)$/;
    my $name = path2modname($_);
    if ($name =~ m/^[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 $_;
}

my $out;

sub output_kurilatoc {
  open($out, ">", "kurilatoc.pod") || die "$^PROGRAM_NAME: creating kurilatoc.pod failed: $^OS_ERROR";

  local $^INPUT_RECORD_SEPARATOR = '';

  ($_= <<"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

	kurilatoc - kurila documentation table of contents

	=head1 DESCRIPTION

	This page provides a brief table of contents for the rest of the Perl Kurila
	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 $_ && (nelems @$_) == 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 kurilatoc.pod

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

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

    while( ~< *ARGV) {
	s/\015//g;
	if (s/^=head1 (NAME)\s*/=head2 /) {
	    $pod = path2modname($ARGV);
	    unhead1();
	    output("\n \n\n=head2 ");
	    $_ = ~< *ARGV;
	    # Remove svn keyword expansions from the Perl FAQ
	    s/ \(\$Revision: \d+ \$\)//g;
	    if ( m/^\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 m/^[\d.]+$/;
	    next if $pod eq 'perlmodlib' && m/^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($str) {
    for (split m/(\n)/, $str) {
	if ($_ eq "\n") {
	    if ($LINE) {
		print $out, wrap('', '', $LINE);
		$LINE = '';
	    }
	    if (($NEWLINE) +< 2) {
		print $out, $_;
		$NEWLINE++;
	    }
	}
	elsif (m/\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 ((nelems @$_) == 2) {
      # Heading
      push @output, "=head2 $_->[1]\n";
    } elsif ((nelems @$_) == 3) {
      # Section
      my $start = " " x (4 + $flags->{indent}) . $_->[1];
      $maxlength = length $start if length ($start) +> $maxlength;
      push @output, \@($start, $_->[2]);
    } elsif ((nelems @$_) == 0) {
      # blank line
      push @output, "\n";
    } else {
      die "$^PROGRAM_NAME: Illegal length " . scalar nelems @$_;
    }
  }
  # 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 m/\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 { 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/.*kurilatoc.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 "$^PROGRAM_NAME: $name contains NUL bytes" if $makefile =~ m/\0/;
  $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm;
  my $sections = @: $makefile =~ m/\0+/g;
  die "$^PROGRAM_NAME: $name contains no README copies" if $sections +< 1;
  die "$^PROGRAM_NAME: $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( < @_ )))/s;

  $makefile =~ s{(del /f [^\n]+checkpods[^\n]+).*?(pod2html)}
    {$("$1\n" . &generate_nmake_2( < @_ )."\n\t    $2")}s;
  $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( < @_ ))}mx) {
    die "$^PROGRAM_NAME: 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 "$^PROGRAM_NAME: could not find $variable in $name"
      unless $body =~ s{\n\U$variable\E = (?:[^\n]*\\\n)*[^\n]*}
	{$("\n" . generate_pod_mak ($variable))}s;
  }
  $body;
}

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

  die "$^PROGRAM_NAME: $name contains NUL bytes" if $makefile =~ m/\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 "$^PROGRAM_NAME: $name contains no copy rules" if $sections +< 1;
  die "$^PROGRAM_NAME: $name contains $sections discontigous copy rules"
    if $sections +> 1;
  $makefile =~ s/\0+/$(join "\n", @( '', < &generate_descrip_mms_2( < @_ )))/s;
  $makefile;
}

sub do_unix {
  my $name = shift;
  my $makefile_SH = join '', @_;
  die "$^PROGRAM_NAME: $name contains NUL bytes" if $makefile_SH =~ m/\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 "$^PROGRAM_NAME: $name contains no copy rules" if $sections +< 1;
  die "$^PROGRAM_NAME: $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, ''))/s;
  $makefile_SH;

}

# Do stuff

my $built;
while (my @(?$target, ?$name) = @: each %Targets) {
  next unless %Build{$target};
  $built++;
  if ($target eq "toc") {
    print\*STDOUT,  "Now processing $name\n" if $Verbose;
    &output_kurilatoc( < @_ );
    print \*STDOUT, "Finished\n" if $Verbose;
    next;
  }
  print\*STDOUT,  "Now processing $name\n" if $Verbose;
  open my $thing, "<", $name or die "Can't open $name: $^OS_ERROR";
  my @orig = @( ~< *$thing );
  my $orig = join '', @orig;
  close $thing;
  my @new = &{"do_$target"}($target, < @orig);
  my $new = join '', @new;
  if ($new eq $orig) {
    print \*STDOUT, "Was not modified\n" if $Verbose;
    next;
  }
  rename $name, "$name.old" or die "$^PROGRAM_NAME: Can't rename $name to $name.old: $^OS_ERROR";
  open $thing, ">", "$name" or die "$^PROGRAM_NAME: Can't open $name for writing: $^OS_ERROR";
  print $thing, $new or die "$^PROGRAM_NAME: print to $name failed: $^OS_ERROR";
  close $thing or die die "$^PROGRAM_NAME: close $name failed: $^OS_ERROR";
}

warn "$^PROGRAM_NAME: was not instructed to build anything\n" unless $built;