X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pod%2Fbuildtoc;h=12cbc945923838caac87951bd5b2f642f475748d;hb=0c359e6f1f1b2532c7bc7180d33870b48256aaff;hp=80ca2ec55cc6080b50f6aec4de97fb7630aae08b;hpb=fb9cefb456488b8b47b32f9b58ac21fa3dc6f725;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pod/buildtoc b/pod/buildtoc old mode 100644 new mode 100755 index 80ca2ec..12cbc94 --- a/pod/buildtoc +++ b/pod/buildtoc @@ -1,135 +1,370 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($masterpodfile %Build %Targets $Verbose $Quiet $Up %Ignore + @Master %Readmes %Pods %Aux %Readmepods %Pragmata %Modules + %Copies %Generated); +use File::Spec; use File::Find; -use Cwd; +use FindBin; +use Text::Tabs; use Text::Wrap; +use Getopt::Long; +use Carp; + +no locale; + +$Up = File::Spec->updir; +$masterpodfile = File::Spec->catfile($Up, "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 + +%Targets + = ( + toc => "perltoc.pod", + manifest => File::Spec->catdir($Up, "MANIFEST"), + perlpod => "perl.pod", + vms => File::Spec->catfile($Up, "vms", "descrip_mms.template"), + nmake => File::Spec->catfile($Up, "win32", "Makefile"), + dmake => File::Spec->catfile($Up, "win32", "makefile.mk"), + podmak => File::Spec->catfile($Up, "win32", "pod.mak"), + # plan9 => File::Spec->catdir($Up, "plan9", "mkfile"), + unix => File::Spec->catfile($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, + quiet => \$Quiet, + 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); + } +} -sub output ($); +# Don't copy these top level READMEs +%Ignore + = ( + micro => 1, +# vms => 1, + ); -@pods = qw( - perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5 - perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata - perlsyn perlop perlre perlrun perlfunc perlvar perlsub - perlmod perlmodlib perlmodinstall perlform perllocale perlref perldsc - perllol perltoot perlobj perltie perlbot perlipc perldebug - perldiag perlsec perltrap perlport perlstyle perlpod perlbook - perlembed perlapio perlxs perlxstut perlguts perlcall - perlhist - ); +if ($Verbose) { + print "I'm building $_\n" foreach grep {$Build{$_}} keys %Build; +} -for (@pods) { s/$/.pod/ } +chdir $FindBin::Bin or die "$0: Can't chdir $FindBin::Bin: $!"; -$/ = ''; -@ARGV = @pods; +open MASTER, $masterpodfile or die "$0: Can't open $masterpodfile: $!"; -($_= <) { + next if /^\#/; - perltoc - perl documentation table of contents + # 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]; - =head1 DESCRIPTION + } elsif (/^(\S*)\s+(\S+)\s+(.*)/) { + # it's a section + my ($flags, $filename, $desc) = ($1, $2, $3); - 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 + 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; -EOPOD2B -#' make emacs happy + 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"; + } + $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 target"; +} -podset(@pods); +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 () { + 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 () { + 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} && !$Generated{$i}; + warn "$0: $i exists but is unknown by perl.pod\n" + if !$perlpods{$i} && !exists $sources{$i}; + } + my @BuildTargets = grep {defined} @Targets{grep $_ ne 'all', keys %Build}; + my %BuildFiles; + @BuildFiles{@BuildTargets} = @BuildTargets; + + foreach my $i (sort keys %our_pods) { + warn "$0: $i is known by buildtoc but does not exist\n" + unless $disk_pods{$i} or $BuildFiles{$i}; + } + foreach my $i (sort keys %manipods) { + warn "$0: $i is known by ../MANIFEST but does not exist\n" + unless $disk_pods{$i}; + warn "$0: $i is known by ../MANIFEST but is marked as generated\n" + if $Generated{$i}; + } + foreach my $i (sort keys %perlpods) { + warn "$0: $i is known by perl.pod but does not exist\n" + unless $disk_pods{$i} or $BuildFiles{$i}; + } +} -find \&getpods => qw(../lib ../ext); +# Find all the modules +{ + my @modpods; + find \&getpods => qw(../lib ../ext); -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 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 = ) { + if ($line =~ /^=head1\s+NAME\b/) { + push @modpods, $file; + #warn "GOOD $file\n"; + close F; + return; + } } + close F; + warn "$0: $file: cannot find =head1 NAME\n" unless $Quiet; + } } -} + } -die "no pods" unless @modpods; + die "$0: no pods" unless @modpods; -for (@modpods) { + my %done; + for (@modpods) { #($name) = /(\w+)\.p(m|od)$/; - $name = path2modname($_); + my $name = path2modname($_); if ($name =~ /^[a-z]/) { - push @pragmata, $_; + $Pragmata{$name} = $_; } else { - if ($done{$name}++) { - # warn "already did $_\n"; - next; - } - push @modules, $_; - push @modname, $name; + if ($done{$name}++) { + # warn "already did $_\n"; + next; + } + $Modules{$name} = $_; } + } } -($_= <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 -podset(sort @pragmata); + # All the things in the master list that happen to be pod filenames + podset(map {"$_->[1].pod"} grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @Master); -($_= <) { + tr/\015//d; if (s/^=head1 (NAME)\s*/=head2 /) { $pod = path2modname($ARGV); - unitem(); - unhead2(); + 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 $_; @@ -162,48 +409,53 @@ sub podset { next; } if (s/^=head1 (.*)/=item $1/) { - unitem(); unhead2(); + unhead2(); + output "=over 4\n\n" unless $inhead1; + $inhead1 = 1; output $_; nl(); next; } if (s/^=head2 (.*)/=item $1/) { unitem(); - output "=over\n\n" unless $inhead2; + output "=over 4\n\n" unless $inhead2; $inhead2 = 1; output $_; nl(); next; - } - if (s/^=item ([^=].*)\n/$1/) { + 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\n\n" unless $initem; + ##print "=over 4\n\n" unless $initem; output ", " if $initem; $initem = 1; s/\.$//; s/^-X\b/-I/; output $_; next; } + if (s/^=cut\s*\n//) { + unhead1(); + next; + } } } -sub path2modname { - local $_ = shift; - s/\.p(m|od)$//; - s-.*?/(lib|ext)/--; - s-/-::-g; - s/(\w+)::\1/$1/; - return $_; +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; - $initem = 0; } sub unitem { @@ -218,18 +470,18 @@ sub nl { output "\n"; } -my $NEWLINE; # how many newlines have we seen recently -my $LINE; # what remains to be printed +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 wrap('', '', $LINE); + print OUT wrap('', '', $LINE); $LINE = ''; } - if ($NEWLINE < 2) { - print; + if (($NEWLINE) < 2) { + print OUT; $NEWLINE++; } } @@ -239,3 +491,281 @@ sub output ($) { } } } + +# 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{$_}]} + 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; +} + +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 {<<"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_descrip_mms_3 { + map qq{\t- If F\$Search("[.pod]$_").nes."" Then Delete/NoConfirm/Log [.pod]$_;*}, + sort keys %Generated, keys %Copies; +} + +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; +} + +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 = 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; + 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{(del /f [^\n]+podchecker[^\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; + 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 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; + +# Looking for rules like this: +# - If F$Search("[.pod]perldelta.pod").nes."" Then Delete/NoConfirm/Log [.pod]perldelta.pod;* + $makefile =~ s!(?:\t- If F\$Search\("\[\.pod\]perl[a-z]+\Q.pod").nes."" Then Delete/NoConfirm/Log [.pod]perl\E[a-z]+\.pod;\*\n)+!\0!sg; + verify_contiguous($name, $makefile, 'delete rules'); + $makefile =~ s/\0+/join "\n", &generate_descrip_mms_3, ''/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{^(perltoc_pod_prereqs = extra.pods).*} + {join ' ', $1, map "pod/$_", + sort keys %Copies, grep {!/perltoc/} keys %Generated + }mge; + +# pod/perldelta.pod: pod/perl511delta.pod +# cd pod && $(LNS) perl511delta.pod perldelta.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++; + 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: $!"; + binmode THING; + my @orig = ; + 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: $!"; + binmode THING; + print THING $new or die "$0: print to $name failed: $!"; + close THING or die "$0: close $name failed: $!"; +} + +warn "$0: was not instructed to build anything\n" unless $built;