summaryrefslogtreecommitdiff
path: root/pod/buildtoc
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2011-01-22 11:25:34 +0000
committerNicholas Clark <nick@ccl4.org>2011-01-22 11:28:37 +0000
commit02cc404a20a8a3455fdf6de6ebfceeaf359b205e (patch)
treef5d27739d7647738ea5c1dcf6df766172d2c3966 /pod/buildtoc
parent71878e4961ded587d93a173105ba984ba4fbfbc8 (diff)
downloadperl-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/buildtoc46
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;