summaryrefslogtreecommitdiff
path: root/regen/regen_lib.pl
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2013-07-03 15:23:33 +0200
committerNicholas Clark <nick@ccl4.org>2013-07-07 12:42:02 +0200
commitf1f44974ad7245157b1b472771053946362694f8 (patch)
tree29aaf770aed174411882a52bd8c8c788fbf10404 /regen/regen_lib.pl
parent779d6b4a99e81aab11db9c66ab07286850b2d575 (diff)
downloadperl-f1f44974ad7245157b1b472771053946362694f8.tar.gz
Add an "always update" parameter to regen_lib's open_new().
By default the code in regen_lib compares the newly written file it has just closed with the (assumed) existing file, and only overwrites the existing file if the new file differs. This is a useful behaviour for regeneration scripts. However, it's not ideal for build scripts called from the Makefile, as make assumes that targets will be regenerated (and the timestamp touched). So add an "always update" parameter for the use of Makefile invoked scripts, such as autodoc.pl. If set, delete any existing file early (so that fatal errors during the generation don't confuse the build by leaving an existing stale file around), skip the comparison and skip the diagnostic output listing the changed files. Change autodoc.pl to set this parameter. Correct a typo in an error message in regen_lib's open_new().
Diffstat (limited to 'regen/regen_lib.pl')
-rw-r--r--regen/regen_lib.pl29
1 files changed, 18 insertions, 11 deletions
diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl
index f0bbe936d0..9e79f69775 100644
--- a/regen/regen_lib.pl
+++ b/regen/regen_lib.pl
@@ -34,10 +34,15 @@ sub safer_unlink {
# Open a new file.
sub open_new {
- my ($final_name, $mode, $header) = @_;
+ my ($final_name, $mode, $header, $force) = @_;
my $name = $final_name . '-new';
my $lang = $final_name =~ /\.pod$/ ? 'Pod' :
$final_name =~ /\.(?:c|h|tab|act)$/ ? 'C' : 'Perl';
+ if ($force && -e $final_name) {
+ chmod 0777, $name if $Needs_Write;
+ CORE::unlink $final_name
+ or die "Couldn't unlink $final_name: $!\n";
+ }
my $fh = gensym;
if (!defined $mode or $mode eq '>') {
if (-f $name) {
@@ -47,10 +52,10 @@ sub open_new {
} elsif ($mode eq '>>') {
open $fh, ">>$name" or die "Can't append to $name: $!";
} else {
- die "Unhandled open mode '$mode#";
+ die "Unhandled open mode '$mode'";
}
- @{*$fh}{qw(name final_name lang)}
- = ($name, $final_name, $lang);
+ @{*$fh}{qw(name final_name lang force)}
+ = ($name, $final_name, $lang, $force);
binmode $fh;
print {$fh} read_only_top(lang => $lang, %$header) if $header;
$fh;
@@ -58,7 +63,7 @@ sub open_new {
sub close_and_rename {
my $fh = shift;
- my ($name, $final_name) = @{*{$fh}}{qw(name final_name)};
+ my ($name, $final_name, $force) = @{*{$fh}}{qw(name final_name force)};
close $fh or die "Error closing $name: $!";
if ($TAP) {
@@ -67,13 +72,15 @@ sub close_and_rename {
safer_unlink($name);
return;
}
- if (compare($name, $final_name) == 0) {
- warn "no changes between '$name' & '$final_name'\n" if $Verbose > 0;
- safer_unlink($name);
- return;
+ unless ($force) {
+ if (compare($name, $final_name) == 0) {
+ warn "no changes between '$name' & '$final_name'\n" if $Verbose > 0;
+ safer_unlink($name);
+ return;
+ }
+ warn "changed '$name' to '$final_name'\n" if $Verbose > 0;
+ push @Changed, $final_name unless $Verbose < 0;
}
- warn "changed '$name' to '$final_name'\n" if $Verbose > 0;
- push @Changed, $final_name unless $Verbose < 0;
# Some DOSish systems can't rename over an existing file:
safer_unlink $final_name;