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

diff --git a/autodoc.pl b/autodoc.pl
index 5317bc6..f97af93 100644 (file)
--- 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 1da5f44..b9d2010 100755 (executable)
--- 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 3603570..6ede805 100755 (executable)
--- 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 08c9e83..7f88036 100755 (executable)
--- 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 0c25cdf..da1f91b 100644 (file)
--- 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 be15c40..ea327a0 100644 (file)
--- 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 b6fc11d..239787a 100644 (file)
--- 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 8249265..7605271 100644 (file)
--- 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 669d13c..2f987c5 100644 (file)
--- 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__