diff options
author | Nicholas Clark <nick@ccl4.org> | 2008-03-15 18:37:34 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2008-03-15 18:37:34 +0000 |
commit | 424a4936e3f61f4e8db394f496a116e698cede85 (patch) | |
tree | e19475f64cd932d850b6975251ee284844aaf0d8 /warnings.pl | |
parent | b6b9a09997c80269af874aff41936e014ed728f7 (diff) | |
download | perl-424a4936e3f61f4e8db394f496a116e698cede85.tar.gz |
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
Diffstat (limited to 'warnings.pl')
-rw-r--r-- | warnings.pl | 66 |
1 files changed, 32 insertions, 34 deletions
diff --git a/warnings.pl b/warnings.pl index b639fc6cf4..669d13c6e6 100644 --- a/warnings.pl +++ b/warnings.pl @@ -250,12 +250,10 @@ if (@ARGV && $ARGV[0] eq "tree") exit ; } -open(WARN, ">warnings.h-new") || die "Can't create warnings.h: $!\n"; -open(PM, ">lib/warnings.pm-new") || die "Can't create lib/warnings.pm: $!\n"; -binmode WARN; -binmode PM; +my $warn = safer_open("warnings.h-new"); +my $pm = safer_open("lib/warnings.pm-new"); -print WARN <<'EOM' ; +print $warn <<'EOM' ; /* -*- buffer-read-only: t -*- !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by warnings.pl @@ -307,19 +305,19 @@ my $k ; my $last_ver = 0; foreach $k (sort { $a <=> $b } keys %ValueToName) { my ($name, $version) = @{ $ValueToName{$k} }; - print WARN "\n/* Warnings Categories added in Perl $version */\n\n" + print $warn "\n/* Warnings Categories added in Perl $version */\n\n" if $last_ver != $version ; - print WARN tab(5, "#define WARN_$name"), "$k\n" ; + print $warn tab(5, "#define WARN_$name"), "$k\n" ; $last_ver = $version ; } -print WARN "\n" ; +print $warn "\n" ; -print WARN tab(5, '#define WARNsize'), "$warn_size\n" ; +print $warn tab(5, '#define WARNsize'), "$warn_size\n" ; #print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ; -print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ; -print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ; +print $warn tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ; +print $warn tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ; -print WARN <<'EOM'; +print $warn <<'EOM'; #define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD) #define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD) @@ -364,70 +362,70 @@ print WARN <<'EOM'; /* ex: set ro: */ EOM -close WARN ; -safer_rename("warnings.h-new", "warnings.h"); +close $warn; +rename_if_different("warnings.h-new", "warnings.h"); while (<DATA>) { last if /^KEYWORDS$/ ; - print PM $_ ; + print $pm $_ ; } #$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ; $last_ver = 0; -print PM "our %Offsets = (\n" ; +print $pm "our %Offsets = (\n" ; foreach my $k (sort { $a <=> $b } keys %ValueToName) { my ($name, $version) = @{ $ValueToName{$k} }; $name = lc $name; $k *= 2 ; if ( $last_ver != $version ) { - print PM "\n"; - print PM tab(4, " # Warnings Categories added in Perl $version"); - print PM "\n\n"; + print $pm "\n"; + print $pm tab(4, " # Warnings Categories added in Perl $version"); + print $pm "\n\n"; } - print PM tab(4, " '$name'"), "=> $k,\n" ; + print $pm tab(4, " '$name'"), "=> $k,\n" ; $last_ver = $version; } -print PM " );\n\n" ; +print $pm " );\n\n" ; -print PM "our %Bits = (\n" ; +print $pm "our %Bits = (\n" ; foreach $k (sort keys %list) { my $v = $list{$k} ; my @list = sort { $a <=> $b } @$v ; - print PM tab(4, " '$k'"), '=> "', + print $pm tab(4, " '$k'"), '=> "', # mkHex($warn_size, @list), mkHex($warn_size, map $_ * 2 , @list), '", # [', mkRange(@list), "]\n" ; } -print PM " );\n\n" ; +print $pm " );\n\n" ; -print PM "our %DeadBits = (\n" ; +print $pm "our %DeadBits = (\n" ; foreach $k (sort keys %list) { my $v = $list{$k} ; my @list = sort { $a <=> $b } @$v ; - print PM tab(4, " '$k'"), '=> "', + print $pm tab(4, " '$k'"), '=> "', # mkHex($warn_size, @list), mkHex($warn_size, map $_ * 2 + 1 , @list), '", # [', mkRange(@list), "]\n" ; } -print PM " );\n\n" ; -print PM '$NONE = "', ('\0' x $warn_size) , "\";\n" ; -print PM '$LAST_BIT = ' . "$index ;\n" ; -print PM '$BYTES = ' . "$warn_size ;\n" ; +print $pm " );\n\n" ; +print $pm '$NONE = "', ('\0' x $warn_size) , "\";\n" ; +print $pm '$LAST_BIT = ' . "$index ;\n" ; +print $pm '$BYTES = ' . "$warn_size ;\n" ; while (<DATA>) { - print PM $_ ; + print $pm $_ ; } -print PM "# ex: set ro:\n"; -close PM ; -safer_rename("lib/warnings.pm-new", "lib/warnings.pm"); +print $pm "# ex: set ro:\n"; +close $pm; +rename_if_different("lib/warnings.pm-new", "lib/warnings.pm"); __END__ # -*- buffer-read-only: t -*- |