In regen/*.pl, refactor the repeated code for close and rename if different.

Pass the final file name as an optional second argument of safer_open() and
store it with the file handle. Add a function close_and_rename() which closes
the file handle, then retrieves the final name, and renames the temporary file
if the two differ.

8 files changed, 46 insertions, 64 deletions

diff --git a/regen/embed.pl b/regen/embed.pl
index ab098165ec..b53a69a15c 100755
--- a/regen/embed.pl
+++ b/regen/embed.pl
@@ -187,7 +187,7 @@ sub walk_table (&@) {
 	$F = $filename;
     }
     else {
-	$F = safer_open("$filename-new");
+	$F = safer_open("$filename-new", $filename);
 	print $F do_not_edit ($filename);
     }
     foreach (@embed) {
@@ -197,14 +197,13 @@ sub walk_table (&@) {
     }
     print $F $trailer if $trailer;
     unless (ref $filename) {
-	safer_close($F);
-	rename_if_different("$filename-new", $filename);
+	close_and_rename($F);
     }
 }
 
 # generate proto.h
 {
-    my $pr = safer_open('proto.h-new');
+    my $pr = safer_open('proto.h-new', 'proto.h');
     print $pr do_not_edit ("proto.h"), "START_EXTERN_C\n";
     my $ret;
 
@@ -337,8 +336,7 @@ END_EXTERN_C
 /* ex: set ro: */
 EOF
 
-    safer_close($pr);
-    rename_if_different('proto.h-new', 'proto.h');
+    close_and_rename($pr);
 }
 
 # generates global.sym (API export list)
@@ -417,7 +415,7 @@ sub multoff ($$) {
     return hide("PL_$pre$sym", "PL_$sym");
 }
 
-my $em = safer_open('embed.h-new');
+my $em = safer_open('embed.h-new', 'embed.h');
 
 print $em do_not_edit ("embed.h"), <<'END';
 /* (Doing namespace management portably in C is really gross.) */
@@ -576,10 +574,9 @@ print $em <<'END';
 /* ex: set ro: */
 END
 
-safer_close($em);
-rename_if_different('embed.h-new', 'embed.h');
+close_and_rename($em);
 
-$em = safer_open('embedvar.h-new');
+$em = safer_open('embedvar.h-new', 'embedvar.h');
 
 print $em do_not_edit ("embedvar.h"), <<'END';
 /* (Doing namespace management portably in C is really gross.) */
@@ -658,11 +655,10 @@ print $em <<'END';
 /* ex: set ro: */
 END
 
-safer_close($em);
-rename_if_different('embedvar.h-new', 'embedvar.h');
+close_and_rename($em);
 
-my $capi = safer_open('perlapi.c-new');
-my $capih = safer_open('perlapi.h-new');
+my $capi = safer_open('perlapi.c-new', 'perlapi.c');
+my $capih = safer_open('perlapi.h-new', 'perlapi.h');
 
 print $capih do_not_edit ("perlapi.h"), <<'EOT';
 /* declare accessor functions for Perl variables */
@@ -769,8 +765,7 @@ print $capih <<'EOT';
 
 /* ex: set ro: */
 EOT
-safer_close($capih);
-rename_if_different('perlapi.h-new', 'perlapi.h');
+close_and_rename($capih);
 
 my $warning = do_not_edit ("perlapi.c");
 $warning =~ s! \*/\n! *
@@ -825,7 +820,6 @@ END_EXTERN_C
 /* ex: set ro: */
 EOT
 
-safer_close($capi);
-rename_if_different('perlapi.c-new', 'perlapi.c');
+close_and_rename($capi);
 
 # ex: set ts=8 sts=4 sw=4 noet:
diff --git a/regen/keywords.pl b/regen/keywords.pl
index be87d9ef17..185d433f17 100755
--- a/regen/keywords.pl
+++ b/regen/keywords.pl
@@ -14,7 +14,7 @@ use strict;
 
 require 'regen/regen_lib.pl';
 
-my $kw = safer_open("keywords.h-new");
+my $kw = safer_open('keywords.h-new', 'keywords.h');
 select $kw;
 
 print read_only_top(lang => 'C', by => 'regen/keywords.pl', from => 'its data',
@@ -34,9 +34,7 @@ while (<DATA>) {
 
 print $kw "\n/* ex: set ro: */\n";
 
-safer_close($kw);
-
-rename_if_different("keywords.h-new", "keywords.h");
+close_and_rename($kw);
 
 ###########################################################################
 sub tab {
diff --git a/regen/opcode.pl b/regen/opcode.pl
index d0a3e1b90f..676583d0e3 100755
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -20,10 +20,8 @@ BEGIN {
     require 'regen/regen_lib.pl';
 }
 
-my $opcode_new = 'opcode.h-new';
-my $opname_new = 'opnames.h-new';
-my $oc = safer_open($opcode_new);
-my $on = safer_open($opname_new);
+my $oc = safer_open('opcode.h-new', 'opcode.h');
+my $on = safer_open('opnames.h-new', 'opnames.h');
 select $oc;
 
 # Read data.
@@ -459,15 +457,10 @@ sub gen_op_is_macro {
 
 foreach ($oc, $on) {
     print $_ "/* ex: set ro: */\n";
-    safer_close($_);
+    close_and_rename($_);
 }
 
-rename_if_different $opcode_new, 'opcode.h';
-rename_if_different $opname_new, 'opnames.h';
-
-my $pp_proto_new = 'pp_proto.h-new';
-
-my $pp = safer_open($pp_proto_new);
+my $pp = safer_open('pp_proto.h-new', 'pp_proto.h');
 
 print $pp read_only_top(lang => 'C', by => 'opcode.pl', from => 'its data');
 
@@ -481,9 +474,7 @@ print $pp read_only_top(lang => 'C', by => 'opcode.pl', from => 'its data');
 }
 print $pp "\n/* ex: set ro: */\n";
 
-safer_close($pp);
-
-rename_if_different $pp_proto_new, 'pp_proto.h';
+close_and_rename($pp);
 
 ###########################################################################
 sub tab {
diff --git a/regen/overload.pl b/regen/overload.pl
index d01348a01f..7ff3f124ae 100644
--- a/regen/overload.pl
+++ b/regen/overload.pl
@@ -30,10 +30,10 @@ while (<DATA>) {
   push @names, $name;
 }
 
-my $c = safer_open("overload.c-new");
-my $h = safer_open("overload.h-new");
+my $c = safer_open('overload.c-new', 'overload.c');
+my $h = safer_open('overload.h-new', 'overload.h');
 mkdir("lib/overload", 0777) unless -d 'lib/overload';
-my $p = safer_open('lib/overload/numbers.pm-new');
+my $p = safer_open('lib/overload/numbers.pm-new', 'lib/overload/numbers.pm');
 
 
 select $p;
@@ -129,12 +129,9 @@ print $c <<"EOT";
 };
 EOT
 
-safer_close($h);
-safer_close($c);
-safer_close($p);
-rename_if_different("overload.c-new", "overload.c");
-rename_if_different("overload.h-new","overload.h");
-rename_if_different('lib/overload/numbers.pm-new', 'lib/overload/numbers.pm');
+close_and_rename($h);
+close_and_rename($c);
+close_and_rename($p);
 
 __DATA__
 # Fallback should be the first
diff --git a/regen/reentr.pl b/regen/reentr.pl
index 963dd96e00..0045b1896d 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -51,7 +51,7 @@ my %map = (
 # Example #3: S_CBI   means type func_r(const char*, char*, int)
 
 
-my $h = safer_open("reentr.h-new");
+my $h = safer_open('reentr.h-new', 'reentr.h');
 select $h;
 print read_only_top(lang => 'C', by => 'regen/reentr.pl',
 		    from => 'data in regen/reentr.pl',
@@ -786,12 +786,11 @@ typedef struct {
 /* ex: set ro: */
 EOF
 
-safer_close($h);
-rename_if_different('reentr.h-new', 'reentr.h');
+close_and_rename($h);
 
 # Prepare to write the reentr.c.
 
-my $c = safer_open("reentr.c-new");
+my $c = safer_open('reentr.c-new', 'reentr.c');
 select $c;
 my $top = read_only_top(lang => 'C', by => 'regen/reentr.pl',
 			from => 'data in regen/reentr.pl',
@@ -1082,8 +1081,7 @@ Perl_reentrant_retry(const char *f, ...)
 /* ex: set ro: */
 EOF
 
-safer_close($c);
-rename_if_different('reentr.c-new', 'reentr.c');
+close_and_rename($c);
 
 __DATA__
 asctime S	|time	|const struct tm|B_SB|B_SBI|I_SB|I_SBI
diff --git a/regen/regcomp.pl b/regen/regcomp.pl
index 98a3889ede..ccb8feb145 100644
--- a/regen/regcomp.pl
+++ b/regen/regcomp.pl
@@ -126,9 +126,7 @@ EXTCONST U8 PL_${varname}_bitmask[] = {
 EOP
 }
 
-my $tmp_h = 'regnodes.h-new';
-
-my $out = safer_open($tmp_h);
+my $out = safer_open('regnodes.h-new', 'regnodes.h');
 
 print $out read_only_top(lang => 'C', by => 'regen/regcomp.pl',
 			 from => 'regcomp.sym');
@@ -330,6 +328,4 @@ EOC
 print $out <<EOP;
 /* ex: set ro: */
 EOP
-safer_close($out);
-
-rename_if_different $tmp_h, 'regnodes.h';
+close_and_rename($out);
diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl
index 880a9754d5..d8cbd12bf5 100644
--- a/regen/regen_lib.pl
+++ b/regen/regen_lib.pl
@@ -62,13 +62,14 @@ sub rename_if_different {
 
 # Saf*er*, but not totally safe. And assumes always open for output.
 sub safer_open {
-    my $name = shift;
+    my ($name, $final_name) = @_;
     if (-f $name) {
 	unlink $name or die "$name exists but can't unlink: $!";
     }
     my $fh = gensym;
     open $fh, ">$name" or die "Can't create $name: $!";
     *{$fh}->{name} = $name;
+    *{$fh}->{final_name} = $final_name if defined $final_name;
     binmode $fh;
     $fh;
 }
@@ -128,4 +129,13 @@ EOM
     return $cooked;
 }
 
+sub close_and_rename {
+    my $fh = shift;
+    my $name = *{$fh}->{name};
+    die "No final name specified at open time for $name"
+	unless *{$fh}->{final_name};
+    safer_close($fh);
+    rename_if_different($name, *{$fh}->{final_name});
+}
+
 1;
diff --git a/regen/warnings.pl b/regen/warnings.pl
index 63ed6bce68..6eee635fc4 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -262,8 +262,8 @@ if (@ARGV && $ARGV[0] eq "tree")
     exit ;
 }
 
-my $warn = safer_open("warnings.h-new");
-my $pm = safer_open("lib/warnings.pm-new");
+my $warn = safer_open('warnings.h-new', 'warnings.h');
+my $pm = safer_open('lib/warnings.pm-new', 'lib/warnings.pm');
 
 print $pm read_only_top(lang => 'Perl', by => 'regen/warnings.pl');
 print $warn read_only_top(lang => 'C', by => 'regen/warnings.pl'), <<'EOM';
@@ -369,8 +369,7 @@ print $warn <<'EOM';
 /* ex: set ro: */
 EOM
 
-safer_close $warn;
-rename_if_different("warnings.h-new", "warnings.h");
+close_and_rename($warn);
 
 while (<DATA>) {
     last if /^KEYWORDS$/ ;
@@ -427,8 +426,7 @@ while (<DATA>) {
 }
 
 print $pm "# ex: set ro:\n";
-safer_close $pm;
-rename_if_different("lib/warnings.pm-new", "lib/warnings.pm");
+close_and_rename($pm);
 
 __END__
 package warnings;