diff options
author | Nicholas Clark <nick@ccl4.org> | 2011-01-22 11:25:34 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2011-01-22 11:28:37 +0000 |
commit | 02cc404a20a8a3455fdf6de6ebfceeaf359b205e (patch) | |
tree | f5d27739d7647738ea5c1dcf6df766172d2c3966 /pod/buildtoc | |
parent | 71878e4961ded587d93a173105ba984ba4fbfbc8 (diff) | |
download | perl-02cc404a20a8a3455fdf6de6ebfceeaf359b205e.tar.gz |
In buildtoc, rename &output_perltoc to &do_toc, and integrate its invocation.
There is still some special casing, as all other targets modify an existing
file, but with this change more code is shared.
Diffstat (limited to 'pod/buildtoc')
-rw-r--r-- | pod/buildtoc | 46 |
1 files changed, 24 insertions, 22 deletions
diff --git a/pod/buildtoc b/pod/buildtoc index ce9ac80a41..e4764b06eb 100644 --- a/pod/buildtoc +++ b/pod/buildtoc @@ -318,7 +318,7 @@ close MASTER; my $OUT; -sub output_perltoc { +sub do_toc { my $filename = shift; ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_; @@ -405,9 +405,7 @@ EOPOD2B $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge; - open OUT, '>', $filename or die "$0: creating $filename failed: $!"; - print OUT $OUT; - close OUT; + return $OUT; } # Below are all the auxiliary routines for generating perltoc.pod @@ -730,34 +728,38 @@ 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($name); - print "Finished\n" if $Verbose; - next; - } + my ($orig, $mode); print "Now processing $name\n" if $Verbose; - local $/; - open THING, $name or die "Can't open $name: $!"; - binmode THING; - my $orig = <THING>; - close THING; - die "$0: $name contains NUL bytes" if $orig =~ /\0/; + if ($target ne "toc") { + local $/; + open THING, $name or die "Can't open $name: $!"; + binmode THING; + $orig = <THING>; + close THING; + die "$0: $name contains NUL bytes" if $orig =~ /\0/; + } + my $new = do { no strict 'refs'; &{"do_$target"}($target, $orig); }; - if ($new eq $orig) { - print "Was not modified\n" if $Verbose; - next; + + if (defined $orig) { + if ($new eq $orig) { + print "Was not modified\n" if $Verbose; + 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: $!"; } - my $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 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: $!"; - chmod $mode & 0777, $name or die "$0: can't chmod $mode $name: $!"; + 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; |