Change 33539 by [EMAIL PROTECTED] on 2008/03/17 00:17:26
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.
Affected files ...
... //depot/perl/autodoc.pl#20 edit
... //depot/perl/embed.pl#369 edit
... //depot/perl/keywords.pl#36 edit
... //depot/perl/opcode.pl#180 edit
... //depot/perl/overload.pl#8 edit
... //depot/perl/reentr.pl#58 edit
... //depot/perl/regcomp.pl#24 edit
... //depot/perl/regen_lib.pl#4 edit
... //depot/perl/warnings.pl#65 edit
Differences ...
==== //depot/perl/autodoc.pl#20 (text) ====
Index: perl/autodoc.pl
--- perl/autodoc.pl#19~29738~ 2007-01-09 13:34:50.000000000 -0800
+++ perl/autodoc.pl 2008-03-16 17:17:26.000000000 -0700
@@ -33,7 +33,7 @@
}
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 @@
}
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 @@
}
}
return "";
-} \*DOC;
+} $doc;
for (sort keys %docfuncs) {
# Have you used a full for apidoc or just a func name?
@@ -219,9 +217,9 @@
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 @@
# 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 @@
_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 @@
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 @@
perlguts(1), perlapi(1)
END
-readonly_footer(\*GUTS);
+readonly_footer($guts);
-close GUTS or die "Error closing pod/perlintern.pod: $!";
+safer_close($guts);
==== //depot/perl/embed.pl#369 (xtext) ====
Index: perl/embed.pl
--- perl/embed.pl#368~33538~ 2008-03-15 11:37:34.000000000 -0700
+++ perl/embed.pl 2008-03-16 17:17:26.000000000 -0700
@@ -108,7 +108,7 @@
}
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 @@
/* 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 @@
/* 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 @@
/* 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 @@
/* 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
==== //depot/perl/keywords.pl#36 (xtext) ====
Index: perl/keywords.pl
--- perl/keywords.pl#35~33538~ 2008-03-15 11:37:34.000000000 -0700
+++ perl/keywords.pl 2008-03-16 17:17:26.000000000 -0700
@@ -36,7 +36,7 @@
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");
==== //depot/perl/opcode.pl#180 (xtext) ====
Index: perl/opcode.pl
--- perl/opcode.pl#179~33538~ 2008-03-15 11:37:34.000000000 -0700
+++ perl/opcode.pl 2008-03-16 17:17:26.000000000 -0700
@@ -438,8 +438,8 @@
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 @@
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';
==== //depot/perl/overload.pl#8 (text) ====
Index: perl/overload.pl
--- perl/overload.pl#7~32681~ 2007-12-20 13:52:06.000000000 -0800
+++ perl/overload.pl 2008-03-16 17:17:26.000000000 -0700
@@ -22,10 +22,8 @@
}
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 @@
EOF
}
-select C;
+select $c;
print_header('overload.c');
-select H;
+select $h;
print_header('overload.h');
print <<'EOF';
@@ -67,7 +65,7 @@
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 @@
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 @@
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
==== //depot/perl/reentr.pl#58 (text) ====
Index: perl/reentr.pl
--- perl/reentr.pl#57~33538~ 2008-03-15 11:37:34.000000000 -0700
+++ perl/reentr.pl 2008-03-16 17:17:26.000000000 -0700
@@ -787,7 +787,7 @@
/* 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 @@
/* ex: set ro: */
EOF
-close($c);
+safer_close($c);
rename_if_different('reentr.c-new', 'reentr.c');
__DATA__
==== //depot/perl/regcomp.pl#24 (text) ====
Index: perl/regcomp.pl
--- perl/regcomp.pl#23~33538~ 2008-03-15 11:37:34.000000000 -0700
+++ perl/regcomp.pl 2008-03-16 17:17:26.000000000 -0700
@@ -223,6 +223,6 @@
/* ex: set ro: */
EOP
-close $out or die "close $tmp_h: $!";
+safer_close($out);
rename_if_different $tmp_h, 'regnodes.h';
==== //depot/perl/regen_lib.pl#4 (text) ====
Index: perl/regen_lib.pl
--- perl/regen_lib.pl#3~33538~ 2008-03-15 11:37:34.000000000 -0700
+++ perl/regen_lib.pl 2008-03-16 17:17:26.000000000 -0700
@@ -57,8 +57,14 @@
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;
==== //depot/perl/warnings.pl#65 (text) ====
Index: perl/warnings.pl
--- perl/warnings.pl#64~33538~ 2008-03-15 11:37:34.000000000 -0700
+++ perl/warnings.pl 2008-03-16 17:17:26.000000000 -0700
@@ -362,7 +362,7 @@
/* ex: set ro: */
EOM
-close $warn;
+safer_close $warn;
rename_if_different("warnings.h-new", "warnings.h");
while (<DATA>) {
@@ -424,7 +424,7 @@
}
print $pm "# ex: set ro:\n";
-close $pm;
+safer_close $pm;
rename_if_different("lib/warnings.pm-new", "lib/warnings.pm");
__END__
End of Patch.
