From: Nicholas Clark Date: Mon, 17 Mar 2008 00:17:26 +0000 (+0000) Subject: Drag autodoc.pl and overload.pl into the age of safer_open(). X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=08858ed21b9a4d448437bdae35df5c42fbe1c8bd;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 @@ -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 --- 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 --- a/keywords.pl +++ b/keywords.pl @@ -36,7 +36,7 @@ while () { 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 --- 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 --- a/overload.pl +++ b/overload.pl @@ -22,10 +22,8 @@ while () { } 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 --- 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 --- a/regcomp.pl +++ b/regcomp.pl @@ -223,6 +223,6 @@ print $out <$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 --- 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 () { @@ -424,7 +424,7 @@ while () { } print $pm "# ex: set ro:\n"; -close $pm; +safer_close $pm; rename_if_different("lib/warnings.pm-new", "lib/warnings.pm"); __END__