Rename safer_rename() to rename_if_different(), to accurately describe

what it does. Use File::Compare rather than Digest::MD5, as the files
are small enough to simply read in. (File::Compare dates from 5.004)
Remove safer_rename_always(), which isn't used.
DRY by replacing the cargo-culted "open or die" with a new function
safer_open(), which uses Gensym (5.002) to create an anonymous file
handle, and opens and binmodes the file, or dies.
This necessitates replacing bareword file handles with lexicals in all
the callers.
Correct the names of files in close or die constructions.

p4raw-id: //depot/perl@33538

1 files changed, 43 insertions, 51 deletions

diff --git a/embed.pl b/embed.pl
index 147c8e2cf4..1da5f44369 100755
--- a/embed.pl
+++ b/embed.pl
@@ -79,15 +79,12 @@ sub walk_table (&@) {
     defined $leader or $leader = do_not_edit ($filename);
     my $trailer = shift;
     my $F;
-    local *F;
     if (ref $filename) {	# filehandle
 	$F = $filename;
     }
     else {
 	# safer_unlink $filename if $filename ne '/dev/null';
-	open F, ">$filename-new" or die "Can't open $filename: $!";
-	binmode F;
-	$F = \*F;
+	$F = safer_open("$filename-new");
     }
     print $F $leader if $leader;
     seek IN, 0, 0;		# so we may restart
@@ -112,7 +109,7 @@ sub walk_table (&@) {
     print $F $trailer if $trailer;
     unless (ref $filename) {
 	close $F or die "Error closing $filename: $!";
-	safer_rename("$filename-new", $filename);
+	rename_if_different("$filename-new", $filename);
     }
 }
 
@@ -389,10 +386,9 @@ sub multoff ($$) {
     return hide("PL_$pre$sym", "PL_$sym");
 }
 
-open(EM, '> embed.h-new') or die "Can't create embed.h: $!\n";
-binmode EM;
+my $em = safer_open('embed.h-new');
 
-print EM do_not_edit ("embed.h"), <<'END';
+print $em do_not_edit ("embed.h"), <<'END';
 
 /* (Doing namespace management portably in C is really gross.) */
 
@@ -456,18 +452,18 @@ walk_table {
     # Remember the new state.
     $ifdef_state = $new_ifdef_state;
     $ret;
-} \*EM, "";
+} $em, "";
 
 if ($ifdef_state) {
-    print EM "#endif\n";
+    print $em "#endif\n";
 }
 
 for $sym (sort keys %ppsym) {
     $sym =~ s/^Perl_//;
-    print EM hide($sym, "Perl_$sym");
+    print $em hide($sym, "Perl_$sym");
 }
 
-print EM <<'END';
+print $em <<'END';
 
 #else	/* PERL_IMPLICIT_CONTEXT */
 
@@ -534,26 +530,26 @@ walk_table {
     # Remember the new state.
     $ifdef_state = $new_ifdef_state;
     $ret;
-} \*EM, "";
+} $em, "";
 
 if ($ifdef_state) {
-    print EM "#endif\n";
+    print $em "#endif\n";
 }
 
 for $sym (sort keys %ppsym) {
     $sym =~ s/^Perl_//;
     if ($sym =~ /^ck_/) {
-	print EM hide("$sym(a)", "Perl_$sym(aTHX_ a)");
+	print $em hide("$sym(a)", "Perl_$sym(aTHX_ a)");
     }
     elsif ($sym =~ /^pp_/) {
-	print EM hide("$sym()", "Perl_$sym(aTHX)");
+	print $em hide("$sym()", "Perl_$sym(aTHX)");
     }
     else {
 	warn "Illegal symbol '$sym' in pp.sym";
     }
 }
 
-print EM <<'END';
+print $em <<'END';
 
 #endif	/* PERL_IMPLICIT_CONTEXT */
 
@@ -561,7 +557,7 @@ print EM <<'END';
 
 END
 
-print EM <<'END';
+print $em <<'END';
 
 /* Compatibility stubs.  Compile extensions with -DPERL_NOCOMPAT to
    disable them.
@@ -641,14 +637,12 @@ print EM <<'END';
 /* ex: set ro: */
 END
 
-close(EM) or die "Error closing EM: $!";
-safer_rename('embed.h-new', 'embed.h');
+close($em) or die "Error closing EM: $!";
+rename_if_different('embed.h-new', 'embed.h');
 
-open(EM, '> embedvar.h-new')
-    or die "Can't create embedvar.h: $!\n";
-binmode EM;
+$em = safer_open('embedvar.h-new');
 
-print EM do_not_edit ("embedvar.h"), <<'END';
+print $em do_not_edit ("embedvar.h"), <<'END';
 
 /* (Doing namespace management portably in C is really gross.) */
 
@@ -677,10 +671,10 @@ print EM do_not_edit ("embedvar.h"), <<'END';
 END
 
 for $sym (sort keys %intrp) {
-    print EM multon($sym,'I','vTHX->');
+    print $em multon($sym,'I','vTHX->');
 }
 
-print EM <<'END';
+print $em <<'END';
 
 #else	/* !MULTIPLICITY */
 
@@ -689,14 +683,14 @@ print EM <<'END';
 END
 
 for $sym (sort keys %intrp) {
-    print EM multoff($sym,'I');
+    print $em multoff($sym,'I');
 }
 
-print EM <<'END';
+print $em <<'END';
 
 END
 
-print EM <<'END';
+print $em <<'END';
 
 #endif	/* MULTIPLICITY */
 
@@ -705,21 +699,21 @@ print EM <<'END';
 END
 
 for $sym (sort keys %globvar) {
-    print EM multon($sym,   'G','my_vars->');
-    print EM multon("G$sym",'', 'my_vars->');
+    print $em multon($sym,   'G','my_vars->');
+    print $em multon("G$sym",'', 'my_vars->');
 }
 
-print EM <<'END';
+print $em <<'END';
 
 #else /* !PERL_GLOBAL_STRUCT */
 
 END
 
 for $sym (sort keys %globvar) {
-    print EM multoff($sym,'G');
+    print $em multoff($sym,'G');
 }
 
-print EM <<'END';
+print $em <<'END';
 
 #endif /* PERL_GLOBAL_STRUCT */
 
@@ -728,25 +722,23 @@ print EM <<'END';
 END
 
 for $sym (sort @extvars) {
-    print EM hide($sym,"PL_$sym");
+    print $em hide($sym,"PL_$sym");
 }
 
-print EM <<'END';
+print $em <<'END';
 
 #endif /* PERL_POLLUTE */
 
 /* ex: set ro: */
 END
 
-close(EM) or die "Error closing EM: $!";
-safer_rename('embedvar.h-new', 'embedvar.h');
+close($em) or die "Error closing EM: $!";
+rename_if_different('embedvar.h-new', 'embedvar.h');
 
-open(CAPI, '> perlapi.c-new') or die "Can't create perlapi.c: $!\n";
-binmode CAPI;
-open(CAPIH, '> perlapi.h-new') or die "Can't create perlapi.h: $!\n";
-binmode CAPIH;
+my $capi = safer_open('perlapi.c-new');
+my $capih = safer_open('perlapi.h-new');
 
-print CAPIH do_not_edit ("perlapi.h"), <<'EOT';
+print $capih do_not_edit ("perlapi.h"), <<'EOT';
 
 /* declare accessor functions for Perl variables */
 #ifndef __perlapi_h__
@@ -851,14 +843,14 @@ END_EXTERN_C
 EOT
 
 foreach $sym (sort keys %intrp) {
-    print CAPIH bincompat_var('I',$sym);
+    print $capih bincompat_var('I',$sym);
 }
 
 foreach $sym (sort keys %globvar) {
-    print CAPIH bincompat_var('G',$sym);
+    print $capih bincompat_var('G',$sym);
 }
 
-print CAPIH <<'EOT';
+print $capih <<'EOT';
 
 #endif /* !PERL_CORE */
 #endif /* MULTIPLICITY */
@@ -867,10 +859,10 @@ print CAPIH <<'EOT';
 
 /* ex: set ro: */
 EOT
-close CAPIH or die "Error closing CAPIH: $!";
-safer_rename('perlapi.h-new', 'perlapi.h');
+close $capih or die "Error closing CAPIH: $!";
+rename_if_different('perlapi.h-new', 'perlapi.h');
 
-print CAPI do_not_edit ("perlapi.c"), <<'EOT';
+print $capi do_not_edit ("perlapi.c"), <<'EOT';
 
 #include "EXTERN.h"
 #include "perl.h"
@@ -949,8 +941,8 @@ END_EXTERN_C
 /* ex: set ro: */
 EOT
 
-close(CAPI) or die "Error closing CAPI: $!";
-safer_rename('perlapi.c-new', 'perlapi.c');
+close($capi) or die "Error closing CAPI: $!";
+rename_if_different('perlapi.c-new', 'perlapi.c');
 
 # functions that take va_list* for implementing vararg functions
 # NOTE: makedef.pl must be updated if you add symbols to %vfuncs