X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/68dc074516a6859e3424b48d1647bcb08b1a1a7d..12f3ad4ebe4097bd8c213e744ff27acdf4cbdc2d:/pod/buildtoc diff --git a/pod/buildtoc b/pod/buildtoc index 31712e2..3b61619 100644 --- a/pod/buildtoc +++ b/pod/buildtoc @@ -1,89 +1,361 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($masterpodfile %Build %Targets $Verbose $Quiet %Ignore + @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules + %Copies %Generated $Test); +use File::Spec; use File::Find; -use Cwd; +use FindBin; +use Text::Tabs; use Text::Wrap; +use Getopt::Long; +use Carp; -sub output ($); +no locale; +require 5.010; -@pods = qw( - perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5 - perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata - perlsyn perlop perlre perlrun perlfunc perlvar perlsub - perlmod perlform perllocale perlref perldsc perllol perltoot - perlobj perltie perlbot perlipc perldebug perldiag perlsec - perltrap perlstyle perlpod perlbook perlembed perlapio perlxs - perlxstut perlguts perlcall - ); +{ + my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir); -for (@pods) { s/$/.pod/ } + sub abs_from_top { + my $path = shift; + return File::Spec->catdir($Top, split /\//, $path) if $path =~ s!/\z!!; + return File::Spec->catfile($Top, split /\//, $path); + } +} -$/ = ''; -@ARGV = @pods; +$masterpodfile = abs_from_top('pod.lst'); + +# Generate any/all of these files +# --verbose gives slightly more output +# --quiet suppresses routine warnings +# --build-all tries to build everything +# --build-foo updates foo as follows +# --showfiles shows the files to be changed +# --test exit if perl.pod, pod.lst, MANIFEST are consistent, and regenerated +# files are up to date, die otherwise. + +%Targets + = ( + toc => 'pod/perltoc.pod', + manifest => 'MANIFEST', + perlpod => 'pod/perl.pod', + vms => 'vms/descrip_mms.template', + nmake => 'win32/Makefile', + dmake => 'win32/makefile.mk', + podmak => 'win32/pod.mak', + # plan9 => 'plan9/mkfile'), + unix => 'Makefile.SH', + # TODO: add roffitall + ); + +foreach (values %Targets) { + $_ = abs_from_top($_); +} -($_= < \$Verbose, + quiet => \$Quiet, + showfiles => \$showfiles, + test => \$Test, + map {+"build-$_", \$build_these{$_}} @files, 'all'); + if ($build_these{all}) { + %Build = %Targets; + } else { + while (my ($file, $want) = each %build_these) { + $Build{$file} = $Targets{$file} if $want; + } + } + 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{@files}), + "\n"; + exit(0); + } +} - =head1 NAME +# Don't copy these top level READMEs +%Ignore + = ( + micro => 1, +# vms => 1, + ); - perltoc - perl documentation table of contents +if ($Verbose) { + print "I'm building $_\n" foreach keys %Build; +} - =head1 DESCRIPTION +open my $master, '<', $masterpodfile or die "$0: Can't open $masterpodfile: $!"; - 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. +my ($delta_source, $delta_target); - =head1 BASIC DOCUMENTATION +foreach (<$master>) { + next if /^\#/; -EOPOD2B -#' make emacs happy + # 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); -podset(@pods); + 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; -find \&getpods => qw(../lib ../ext); + if ($flags =~ tr/D//d) { + $flags{manifest_omit} = 1; + $delta_source = "$filename.pod"; + } + if ($flags =~ tr/d//d) { + $flags{perlpod_omit} = 1; + $delta_target = "$filename.pod"; + } + $Generated{"$filename.pod"}++ if $flags =~ tr/g//d; + + if ($flags =~ tr/r//d) { + my $readme = $filename; + $readme =~ s/^perl//; + $Readmepods{$filename} = $Readmes{$readme} = $desc; + $flags{readme} = 1; + } elsif ($flags{aux}) { + $Aux{$filename} = $desc; + } else { + $Pods{$filename} = $desc; + } + die "$0: Unknown flag found in section line: $_" if length $flags; + push @Master, [\%flags, $filename, $desc]; + } elsif (/^$/) { + push @Master, undef; + } else { + die "$0: Malformed line: $_" if $1 =~ tr/A-Z//; + } +} +if (defined $delta_source) { + if (defined $delta_target) { + # This way round so that keys can act as a MANIFEST skip list + # Targets will aways be in the pod directory. Currently we can only cope + # with sources being in the same directory. + $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 source"; +} + +close $master; + +# Sanity cross check +{ + my (%disk_pods, @disk_pods); + my (@manipods, %manipods); + my (@manireadmes, %manireadmes); + my (@perlpods, %perlpods); + my (%our_pods); + + # Convert these to a list of filenames. + foreach (keys %Pods, keys %Readmepods) { + $our_pods{"$_.pod"}++; + } + + opendir my $dh, abs_from_top('pod/'); + while (readdir $dh) { + next unless /\.pod\z/; + push @disk_pods, $_; + ++$disk_pods{$_}; + } + + # Things we copy from won't be in perl.pod + # Things we copy to won't be in MANIFEST + + my $filename = abs_from_top('MANIFEST'); + open my $mani, '<', $filename or die "$0: opening $filename 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 or die $!; + @manipods{@manipods} = @manipods; + @manireadmes{@manireadmes} = @manireadmes; + + $filename = abs_from_top('pod/perl.pod'); + open my $perlpod, '<', $filename or die "$0: opening $filename 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 or die $!; + die "$0: could not find the pod listing of perl.pod\n" + unless @perlpods; + @perlpods{@perlpods} = @perlpods; + + my @inconsistent; + foreach my $i (sort keys %disk_pods) { + push @inconsistent, "$0: $i exists but is unknown by buildtoc\n" + unless $our_pods{$i}; + push @inconsistent, "$0: $i exists but is unknown by ../MANIFEST\n" + if !$manipods{$i} && !$manireadmes{$i} && !$Copies{$i} && !$Generated{$i}; + push @inconsistent, "$0: $i exists but is unknown by perl.pod\n" + if !$perlpods{$i} && !exists $Copies{$i}; + } + my %BuildFiles; + foreach my $path (values %Build) { + (undef, undef, my $file) = File::Spec->splitpath($path); + ++$BuildFiles{$file} + } + + foreach my $i (sort keys %our_pods) { + push @inconsistent, "$0: $i is known by buildtoc but does not exist\n" + unless $disk_pods{$i} or $BuildFiles{$i}; + } + foreach my $i (sort keys %manipods) { + push @inconsistent, "$0: $i is known by ../MANIFEST but does not exist\n" + unless $disk_pods{$i}; + push @inconsistent, "$0: $i is known by ../MANIFEST but is marked as generated\n" + if $Generated{$i}; + } + foreach my $i (sort keys %perlpods) { + push @inconsistent, "$0: $i is known by perl.pod but does not exist\n" + unless $disk_pods{$i} or $BuildFiles{$i}; + } + if ($Test) { + delete $Build{toc}; + printf "1..%d\n", 1 + scalar keys %Build; + if (@inconsistent) { + print "not ok 1\n"; + die @inconsistent + } + print "ok 1\n"; + } + else { + warn @inconsistent if @inconsistent; + } +} + +# Find all the modules +if ($Build{toc}) { + my @modpods; + find \&getpods => abs_from_top('lib/'); -sub getpods { + sub getpods { if (/\.p(od|m)$/) { - # Skip .pm files that have corresponding .pod files, and Functions.pm. - return if /(.*)\.pm$/ && -f "$1.pod"; - my $file = $File::Find::name; - return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself - - die "tut $name" if $file =~ /TUT/; - unless (open (F, "< $_\0")) { - warn "bogus <$file>: $!"; - system "ls", "-l", $file; - } - else { - my $line; - while ($line = ) { - if ($line =~ /^=head1\s+NAME\b/) { - push @modpods, $file; - #warn "GOOD $file\n"; - return; - } - } - warn "EVIL $file\n"; + my $file = $File::Find::name; + return if $file =~ qr!/lib/Pod/Functions.pm\z!; # 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; + unless (open my $f, '<', $_) { + warn "$0: bogus <$file>: $!"; + system "ls", "-l", $file; + } + else { + my $line; + while ($line = <$f>) { + if ($line =~ /^=head1\s+NAME\b/) { + push @modpods, $file; + return; + } } + warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet; + } } -} + } -die "no pods" unless @modpods; + die "$0: no pods" unless @modpods; + + my %done; + for (@modpods) { + my $name = $_; + $name =~ s/\.p(m|od)$//; + $name =~ s-.*?/lib/--; + $name =~ s-/-::-g; + next if $done{$name}++; -for (@modpods) { - #($name) = /(\w+)\.p(m|od)$/; - $name = path2modname($_); if ($name =~ /^[a-z]/) { - push @pragmata, $_; + $Pragmata{$name} = $_; } else { - if ($done{$name}++) { - # warn "already did $_\n"; - next; - } - push @modules, $_; - push @modname, $name; + $Modules{$name} = $_; } + } } -($_= <[0]{toc_omit}} @Master) { + podset($_->[1], abs_from_top("pod/$_->[1].pod")); + } + + + ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_; @@ -91,9 +363,11 @@ for (@modpods) { EOPOD2B -podset(sort @pragmata); + foreach (sort keys %Pragmata) { + podset($_, $Pragmata{$_}); + } -($_= <>, with the help of oodles + of other folks. - =item xsubpp - =item pod2man +EOPOD2B - =item wrapsuid + s/^\t//gm; + $OUT .= "$_\n"; + $OUT =~ s/\n\s+\n/\n\n/gs; + $OUT =~ s/\n{3,}/\n\n/g; - =head1 AUTHOR + $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge; - Larry Wall >, with the help of oodles - of other folks. + return $OUT; +} +# Below are all the auxiliary routines for generating perltoc.pod -EOPOD2B -output $_; -output "\n"; # flush $LINE -exit; +my ($inhead1, $inhead2, $initem); sub podset { - local @ARGV = @_; + my ($pod, $file) = @_; + + local $/ = ''; - while(<>) { + open my $fh, '<', $file or die "Can't open file '$file' for $pod: $!"; + + while(<$fh>) { + tr/\015//d; if (s/^=head1 (NAME)\s*/=head2 /) { - $pod = path2modname($ARGV); - unitem(); - unhead2(); - output "\n \n\n=head2 "; - $_ = <>; - if ( /^\s*$pod\b/ ) { + unhead1(); + $OUT .= "\n\n=head2 "; + $_ = <$fh>; + # Remove svn keyword expansions from the Perl FAQ + s/ \(\$Revision: \d+ \$\)//g; + if ( /^\s*\Q$pod\E\b/ ) { s/$pod\.pm/$pod/; # '.pm' in NAME !? - output $_; } else { s/^/$pod, /; - output $_; } - next; } - if (s/^=head1 (.*)/=item $1/) { - unitem(); unhead2(); - output $_; nl(); next; + elsif (s/^=head1 (.*)/=item $1/) { + unhead2(); + $OUT .= "=over 4\n\n" unless $inhead1; + $inhead1 = 1; + $_ .= "\n"; } - if (s/^=head2 (.*)/=item $1/) { + elsif (s/^=head2 (.*)/=item $1/) { unitem(); - output "=over\n\n" unless $inhead2; + $OUT .= "=over 4\n\n" unless $inhead2; $inhead2 = 1; - output $_; nl(); next; - + $_ .= "\n"; } - if (s/^=item (.*)\n/$1/) { + elsif (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 'perlmod' && /^ftp:/; - ##print "=over\n\n" unless $initem; - output ", " if $initem; + next if $pod eq 'perlmodlib' && /^ftp:/; + $OUT .= ", " if $initem; $initem = 1; s/\.$//; s/^-X\b/-I/; - output $_; next; } + else { + unhead1() if /^=cut\s*\n/; + next; + } + $OUT .= $_; } } -sub path2modname { - local $_ = shift; - s/\.p(m|od)$//; - s-.*?/(lib|ext)/--; - s-/-::-g; - s/(\w+)::\1/$1/; - return $_; +sub unhead1 { + unhead2(); + if ($inhead1) { + $OUT .= "\n\n=back\n\n"; + } + $inhead1 = 0; } sub unhead2 { + unitem(); if ($inhead2) { - output "\n\n=back\n\n"; + $OUT .= "\n\n=back\n\n"; } $inhead2 = 0; - $initem = 0; } sub unitem { if ($initem) { - output "\n\n"; - ##print "\n\n=back\n\n"; + $OUT .= "\n\n"; } $initem = 0; } -sub nl { - output "\n"; +# 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 { + # Annoyingly, 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", @$_} @_); + map {s/ \t/\t\t/g; $_} @temp; +} +sub generate_manifest_pod { + generate_manifest map {["pod/$_.pod", $Pods{$_}]} + sort grep {!$Copies{"$_.pod"}} grep {!$Generated{"$_.pod"}} keys %Pods; +} +sub generate_manifest_readme { + generate_manifest sort {$a->[0] cmp $b->[0]} + ["README.vms", "Notes about installing the VMS port"], + map {["README.$_", $Readmes{$_}]} keys %Readmes; } -my $NEWLINE; # how many newlines have we seen recently -my $LINE; # what remains to be printed +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 output ($) { - for (split /(\n)/, shift) { - if ($_ eq "\n") { - if ($LINE) { - print wrap('', '', $LINE); - $LINE = ''; - } - if ($NEWLINE < 2) { - print; - $NEWLINE++; - } - } - elsif (/\S/ && length) { - $LINE .= $_; - $NEWLINE = 0; - } +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 {<<"SNIP"} +[.lib.pods]$_.pod : [.pod]$_.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, keys %Generated, + map {"perl$_.pod"} keys %Readmes); + $line =~ s/$/ \\/mg; + $line =~ s/ \\$//; + $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 verify_contiguous { + my ($name, $content, $what) = @_; + my $sections = () = $content =~ m/\0+/g; + croak("$0: $name contains no $what") if $sections < 1; + croak("$0: $name contains discontiguous $what") if $sections > 1; +} + +sub do_manifest { + my ($name, $prev) = @_; + my @manifest = + grep {! m!^pod/[^.]+\.pod.*!} + grep {! m!^README\.(\S+)! || $Ignore{$1}} split "\n", $prev; + join "\n", ( + # 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, $makefile) = @_; + $makefile =~ s/^\tcopy \.\.\\README.*\n/\0/gm; + verify_contiguous($name, $makefile, 'README copies'); + # 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{(-cd \$\(PODDIR\) && del /f[^\n]+).*?(-cd \.\.\\utils && del /f)} + {"$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, $pod) = @_; + + 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, $body) = @_; + 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, $makefile) = @_; + $makefile =~ s/\npod\d* =[^\n]*/\0/gs; + verify_contiguous($name, $makefile, 'pod assignments'); + $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_1/se; + + die "$0: $name contains NUL bytes" if $makefile =~ /\0/; + +# Looking for the macro defining the current perldelta: +#PERLDELTA_CURRENT = [.pod]perl5139delta.pod + + $makefile =~ s/\nPERLDELTA_CURRENT\s+=\s+\Q[.pod]perl\E\d+delta\.pod\n + /\0/sx; + verify_contiguous($name, $makefile, 'current perldelta macro'); + $makefile =~ s/\0+/join "\n", '', "PERLDELTA_CURRENT = [.pod]$delta_target", ''/se; + +# 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; + verify_contiguous($name, $makefile, 'copy rules'); + $makefile =~ s/\0+/join "\n", '', &generate_descrip_mms_2/se; + + $makefile; +} + +sub do_unix { + my ($name, $makefile_SH) = @_; + + $makefile_SH =~ s{^(perltoc_pod_prereqs = extra.pods).*} + {join ' ', $1, map "pod/$_", + sort keys %Copies, grep {!/perltoc/} keys %Generated + }mge; + +# pod/perl511delta.pod: pod/perldelta.pod +# cd pod && $(LNS) perldelta.pod perl511delta.pod + + $makefile_SH =~ s!( +pod/perl[a-z0-9_]+\.pod: pod/perl[a-z0-9_]+\.pod + \$\(LNS\) perl[a-z0-9_]+\.pod pod/perl[a-z0-9_]+\.pod +)+!\0!gm; + + verify_contiguous($name, $makefile_SH, 'copy rules'); + + my @copy_rules = map " +pod/$_: pod/$Copies{$_} + \$(LNS) $Copies{$_} pod/$_ +", keys %Copies; + + $makefile_SH =~ s/\0+/join '', @copy_rules/se; + $makefile_SH; + +} + +# Do stuff + +my $built; +while (my ($target, $name) = each %Targets) { + print "Working on target $target\n" if $Verbose; + next unless $Build{$target}; + $built++; + my ($orig, $mode); + print "Now processing $name\n" if $Verbose; + if ($target ne "toc") { + local $/; + open my $thing, '<', $name or die "Can't open $name: $!"; + binmode $thing; + $orig = <$thing>; + die "$0: $name contains NUL bytes" if $orig =~ /\0/; + } + + my $new = do { + no strict 'refs'; + &{"do_$target"}($target, $orig); + }; + + if (defined $orig) { + if ($new eq $orig) { + if ($Test) { + printf "ok %d # $name is up to date\n", $built + 1; + } elsif ($Verbose) { + print "Was not modified\n"; + } + next; + } elsif ($Test) { + printf "not ok %d # $name is up to date\n", $built + 1; + next; } + $mode = (stat $name)[2] // die "$0: Can't stat $name: $!"; + rename $name, "$name.old" or die "$0: Can't rename $name to $name.old: $!"; + } + + open my $thing, '>', $name or die "$0: Can't open $name for writing: $!"; + binmode $thing; + print $thing $new or die "$0: print to $name failed: $!"; + close $thing or die "$0: close $name failed: $!"; + if (defined $mode) { + chmod $mode & 0777, $name or die "$0: can't chmod $mode $name: $!"; + } } + +warn "$0: was not instructed to build anything\n" unless $built || $Test;