From f038801aea0ff24cf86511fa6679d7dcb859cd8d Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sun, 23 Jan 2011 10:07:52 +0000 Subject: [PATCH] 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. --- regen/embed.pl | 30 ++++++++++++------------------ regen/keywords.pl | 6 ++---- regen/opcode.pl | 19 +++++-------------- regen/overload.pl | 15 ++++++--------- regen/reentr.pl | 10 ++++------ regen/regcomp.pl | 8 ++------ regen/regen_lib.pl | 12 +++++++++++- regen/warnings.pl | 10 ++++------ 8 files changed, 46 insertions(+), 64 deletions(-) diff --git a/regen/embed.pl b/regen/embed.pl index ab09816..b53a69a 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 be87d9e..185d433 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 () { 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 d0a3e1b..676583d 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 d01348a..7ff3f12 100644 --- a/regen/overload.pl +++ b/regen/overload.pl @@ -30,10 +30,10 @@ while () { 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 963dd96..0045b18 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 98a3889..ccb8feb 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 <$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 63ed6bc..6eee635 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 () { last if /^KEYWORDS$/ ; @@ -427,8 +426,7 @@ while () { } 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; -- 1.8.3.1