Drag autodoc.pl and overload.pl into the age of safer_open().

Thanks to the wisdom of london.pm, stuff the filename into the SCALAR
slot of the typeglob created in safer_open(), so that ...
Add safer_close(), that will die (with the filename) if the close
fails.

p4raw-id: //depot/perl@33539

9 files changed, 52 insertions, 52 deletions

diff --git a/autodoc.pl b/autodoc.pl
index 5317bc6da1..f97af93acf 100644
--- a/autodoc.pl
+++ b/autodoc.pl
@@ -33,7 +33,7 @@ sub walk_table (&@) {
     }
     else {
 	safer_unlink $filename;
-	open F, ">$filename" or die "Can't open $filename: $!";
+	$F = safer_open($filename);
 	binmode F;
 	$F = \*F;
     }
@@ -183,9 +183,7 @@ for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
 }
 
 safer_unlink "pod/perlapi.pod";
-open (DOC, ">pod/perlapi.pod") or
-	die "Can't create pod/perlapi.pod: $!\n";
-binmode DOC;
+my $doc = safer_open("pod/perlapi.pod");
 
 walk_table {	# load documented functions into appropriate hash
     if (@_ > 1) {
@@ -211,7 +209,7 @@ walk_table {	# load documented functions into appropriate hash
 	}
     }
     return "";
-} \*DOC;
+} $doc;
 
 for (sort keys %docfuncs) {
     # Have you used a full for apidoc or just a func name?
@@ -219,9 +217,9 @@ for (sort keys %docfuncs) {
     warn "Unable to place $_!\n";
 }
 
-readonly_header(\*DOC);
+readonly_header($doc);
 
-print DOC <<'_EOB_';
+print $doc <<'_EOB_';
 =head1 NAME
 
 perlapi - autogenerated documentation for the perl public API
@@ -248,15 +246,15 @@ my $key;
 # case insensitive sort, with fallback for determinacy
 for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %apidocs) {
     my $section = $apidocs{$key}; 
-    print DOC "\n=head1 $key\n\n=over 8\n\n";
+    print $doc "\n=head1 $key\n\n=over 8\n\n";
     # Again, fallback for determinacy
     for my $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$section) {
-        docout(\*DOC, $key, $section->{$key});
+        docout($doc, $key, $section->{$key});
     }
-    print DOC "\n=back\n";
+    print $doc "\n=back\n";
 }
 
-print DOC <<'_EOE_';
+print $doc <<'_EOE_';
 
 =head1 AUTHORS
 
@@ -278,16 +276,14 @@ perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
 
 _EOE_
 
-readonly_footer(\*DOC);
+readonly_footer($doc);
 
-close(DOC) or die "Error closing pod/perlapi.pod: $!";
+safer_close($doc);
 
 safer_unlink "pod/perlintern.pod";
-open(GUTS, ">pod/perlintern.pod") or
-		die "Unable to create pod/perlintern.pod: $!\n";
-binmode GUTS;
-readonly_header(\*GUTS);
-print GUTS <<'END';
+my $guts = safer_open("pod/perlintern.pod");
+readonly_header($guts);
+print $guts <<'END';
 =head1 NAME
 
 perlintern - autogenerated documentation of purely B<internal>
@@ -305,14 +301,14 @@ END
 
 for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
     my $section = $gutsdocs{$key}; 
-    print GUTS "\n=head1 $key\n\n=over 8\n\n";
+    print $guts "\n=head1 $key\n\n=over 8\n\n";
     for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
-        docout(\*GUTS, $key, $section->{$key});
+        docout($guts, $key, $section->{$key});
     }
-    print GUTS "\n=back\n";
+    print $guts "\n=back\n";
 }
 
-print GUTS <<'END';
+print $guts <<'END';
 
 =head1 AUTHORS
 
@@ -325,6 +321,6 @@ document their functions.
 perlguts(1), perlapi(1)
 
 END
-readonly_footer(\*GUTS);
+readonly_footer($guts);
 
-close GUTS or die "Error closing pod/perlintern.pod: $!";
+safer_close($guts);
diff --git a/embed.pl b/embed.pl
index 1da5f44369..b9d2010d49 100755
--- a/embed.pl
+++ b/embed.pl
@@ -108,7 +108,7 @@ sub walk_table (&@) {
     }
     print $F $trailer if $trailer;
     unless (ref $filename) {
-	close $F or die "Error closing $filename: $!";
+	safer_close($F);
 	rename_if_different("$filename-new", $filename);
     }
 }
@@ -637,7 +637,7 @@ print $em <<'END';
 /* ex: set ro: */
 END
 
-close($em) or die "Error closing EM: $!";
+safer_close($em);
 rename_if_different('embed.h-new', 'embed.h');
 
 $em = safer_open('embedvar.h-new');
@@ -732,7 +732,7 @@ print $em <<'END';
 /* ex: set ro: */
 END
 
-close($em) or die "Error closing EM: $!";
+safer_close($em);
 rename_if_different('embedvar.h-new', 'embedvar.h');
 
 my $capi = safer_open('perlapi.c-new');
@@ -859,7 +859,7 @@ print $capih <<'EOT';
 
 /* ex: set ro: */
 EOT
-close $capih or die "Error closing CAPIH: $!";
+safer_close($capih);
 rename_if_different('perlapi.h-new', 'perlapi.h');
 
 print $capi do_not_edit ("perlapi.c"), <<'EOT';
@@ -941,7 +941,7 @@ END_EXTERN_C
 /* ex: set ro: */
 EOT
 
-close($capi) or die "Error closing CAPI: $!";
+safer_close($capi);
 rename_if_different('perlapi.c-new', 'perlapi.c');
 
 # functions that take va_list* for implementing vararg functions
diff --git a/keywords.pl b/keywords.pl
index 36035705c4..6ede80524c 100755
--- a/keywords.pl
+++ b/keywords.pl
@@ -36,7 +36,7 @@ while (<DATA>) {
 
 print $kw "\n/* ex: set ro: */\n";
 
-close $kw or die "Error closing keywords.h-new: $!";
+safer_close($kw);
 
 rename_if_different("keywords.h-new", "keywords.h");
 
diff --git a/opcode.pl b/opcode.pl
index 08c9e8327f..7f88036ea3 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -438,8 +438,8 @@ sub gen_op_is_macro {
 print $oc "/* ex: set ro: */\n";
 print $on "/* ex: set ro: */\n";
 
-close $oc or die "Error closing $opcode_new: $!\n";
-close $on or die "Error closing $opname_new: $!\n";
+safer_close($oc);
+safer_close($on);
 
 rename_if_different $opcode_new, 'opcode.h';
 rename_if_different $opname_new, 'opnames.h';
@@ -487,8 +487,8 @@ for (@ops) {
 print $pp "\n/* ex: set ro: */\n";
 print $ppsym "\n# ex: set ro:\n";
 
-close $pp or die "Error closing pp_proto.h-new: $!\n";
-close $ppsym or die "Error closing pp.sym-new: $!\n";
+safer_close($pp);
+safer_close($ppsym);
 
 rename_if_different $pp_proto_new, 'pp_proto.h';
 rename_if_different $pp_sym_new, 'pp.sym';
diff --git a/overload.pl b/overload.pl
index 0c25cdf494..da1f91b64e 100644
--- a/overload.pl
+++ b/overload.pl
@@ -22,10 +22,8 @@ while (<DATA>) {
 }
 
 safer_unlink ('overload.h', 'overload.c');
-die "overload.h: $!" unless open(C, ">overload.c");
-binmode C;
-die "overload.h: $!" unless open(H, ">overload.h");
-binmode H;
+my $c = safer_open("overload.c");
+my $h = safer_open("overload.h");
 
 sub print_header {
   my $file = shift;
@@ -46,10 +44,10 @@ sub print_header {
 EOF
 }
 
-select C;
+select $c;
 print_header('overload.c');
 
-select H;
+select $h;
 print_header('overload.h');
 print <<'EOF';
 
@@ -67,7 +65,7 @@ print <<'EOF';
 
 EOF
 
-print C <<'EOF';
+print $c <<'EOF';
 
 #define AMG_id2name(id) (PL_AMG_names[id]+1)
 #define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
@@ -77,10 +75,10 @@ EOF
 
 my $last = pop @names;
 
-print C "    $_,\n" foreach map { length $_ } @names;
+print $c "    $_,\n" foreach map { length $_ } @names;
 
 my $lastlen = length $last;
-print C <<"EOT";
+print $c <<"EOT";
     $lastlen
 };
 
@@ -92,15 +90,15 @@ const char * const PL_AMG_names[NofAMmeth] = {
      overload.pm.  */
 EOT
 
-print C "    \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
+print $c "    \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
 
-print C <<"EOT";
+print $c <<"EOT";
     "$last"
 };
 EOT
 
-close H or die $!;
-close C or die $!;
+safer_close($h);
+safer_close($c);
 
 __DATA__
 # Fallback should be the first
diff --git a/reentr.pl b/reentr.pl
index be15c40609..ea327a09fe 100644
--- a/reentr.pl
+++ b/reentr.pl
@@ -787,7 +787,7 @@ typedef struct {
 /* ex: set ro: */
 EOF
 
-close($h);
+safer_close($h);
 rename_if_different('reentr.h-new', 'reentr.h');
 
 # Prepare to write the reentr.c.
@@ -1089,7 +1089,7 @@ Perl_reentrant_retry(const char *f, ...)
 /* ex: set ro: */
 EOF
 
-close($c);
+safer_close($c);
 rename_if_different('reentr.c-new', 'reentr.c');
 
 __DATA__
diff --git a/regcomp.pl b/regcomp.pl
index b6fc11dae1..239787ae55 100644
--- a/regcomp.pl
+++ b/regcomp.pl
@@ -223,6 +223,6 @@ print $out <<EOP;
 
 /* ex: set ro: */
 EOP
-close $out or die "close $tmp_h: $!";
+safer_close($out);
 
 rename_if_different $tmp_h, 'regnodes.h';
diff --git a/regen_lib.pl b/regen_lib.pl
index 824926554a..7605271ec8 100644
--- a/regen_lib.pl
+++ b/regen_lib.pl
@@ -57,8 +57,14 @@ sub safer_open {
     my $name = shift;
     my $fh = gensym;
     open $fh, ">$name" or die "Can't create $name: $!";
+    *{$fh}->{SCALAR} = $name;
     binmode $fh;
     $fh;
 }
 
+sub safer_close {
+    my $fh = shift;
+    close $fh or die 'Error closing ' . *{$fh}->{SCALAR} . ": $!";
+}
+
 1;
diff --git a/warnings.pl b/warnings.pl
index 669d13c6e6..2f987c5da2 100644
--- a/warnings.pl
+++ b/warnings.pl
@@ -362,7 +362,7 @@ print $warn <<'EOM';
 /* ex: set ro: */
 EOM
 
-close $warn;
+safer_close $warn;
 rename_if_different("warnings.h-new", "warnings.h");
 
 while (<DATA>) {
@@ -424,7 +424,7 @@ while (<DATA>) {
 }
 
 print $pm "# ex: set ro:\n";
-close $pm;
+safer_close $pm;
 rename_if_different("lib/warnings.pm-new", "lib/warnings.pm");
 
 __END__