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().

diff --git a/autodoc.pl b/autodoc.pl
index f82593e..1ef62b5 100644 (file)
--- a/autodoc.pl
+++ b/autodoc.pl
@@ -254,7 +254,7 @@ sub output {
     my ($podname, $header, $dochash, $missing, $footer) = @_;
     my $fh = open_new("pod/$podname.pod", undef,
                      {by => "$0 extracting documentation",
-                      from => 'the C source files'});
+                       from => 'the C source files'}, 1);
 
     print $fh $header;
 

diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl
index f0bbe93..9e79f69 100644 (file)
--- 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;