Tim,
I spent some time further quantifying the 'die' handling issue. It looks
as if it might be sufficient to locally clear the SIG{__DIE__} handler in
any blocks where where we eval calls through the proxy client. Let me
know what you think of the proposed patches? I'm not completely convinced
that it's necessary in the FETCH and STORE handlers, for example.
Also, there were two small items not present in your DBI-1.31 strawman,
one suppressed logging of failed calls on the server in the absence of
--debug. The other is a thinko that doesn't work (and is no longer
needed, given your fix to common_set_err()).
Steve
--------------------------- Cut Here -----------------------------
--- Proxy.pm.orig Fri Sep 13 18:40:20 2002
+++ Proxy.pm Wed Sep 18 09:56:20 2002
@@ -61,7 +61,7 @@
sub proxy_set_err {
my ($h,$errmsg) = @_;
my ($err,$state) =
- ($errmsg =~ s/ \[err=(.*?),state=(.*?)\]//) ? ($1,$2) : (1,5 x ' ');
+ ($errmsg =~ s/ \[err=(.*?),state=(.*?)\]//) ? ($1,$2) : (1,'');
return DBI::set_err($h, $err, $errmsg, $state);
}
@@ -234,6 +234,7 @@
'type' => $type,
'h' => "DBI::_::$type"
);
+ local $SIG{__DIE__} = 'DEFAULT';
my $method_code = UNIVERSAL::can($expand{'h'}, $method) ?
q/package ~class~;
sub ~method~ {
@@ -283,6 +284,7 @@
}
if ($type eq 'remote' || $type eq 'cached') {
+ local $SIG{__DIE__} = 'DEFAULT';
my $result = eval { $dbh->{'proxy_dbh'}->STORE($attr => $val) };
return DBD::Proxy::proxy_set_err($dbh, $@) if $@; # returns undef
$dbh->{$attr} = $val if $type eq 'cached';
@@ -302,6 +304,7 @@
return $dbh->SUPER::FETCH($attr) unless $type eq 'remote';
+ local $SIG{__DIE__} = 'DEFAULT';
my $result = eval { $dbh->{'proxy_dbh'}->FETCH($attr) };
return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
return $result;
@@ -320,6 +323,7 @@
if ( $proto_ver > 1 ) {
$sth->{'proxy_attr_cache'} = {cache_filled => 0};
my $rdbh = $dbh->{'proxy_dbh'};
+ local $SIG{__DIE__} = 'DEFAULT';
my $rsth = eval { $rdbh->prepare($sth->{'Statement'}, $sth->{'proxy_attr'},
undef, $proto_ver) };
return DBD::Proxy::proxy_set_err($sth, $@) if $@;
return DBD::Proxy::proxy_set_err($sth, "Constructor didn't return a handle:
$rsth")
@@ -355,7 +359,7 @@
# $dbh->{'proxy_quote'} = 'backslash_escaped';
# for example.
# Jochen
-
+ local $SIG{__DIE__} = 'DEFAULT';
my $result = eval { $dbh->{'proxy_dbh'}->quote(@_) };
return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
return $result;
@@ -365,6 +369,7 @@
my $dbh = shift;
my $rdbh = $dbh->{'proxy_dbh'};
#warn "table_info(@_)";
+ local $SIG{__DIE__} = 'DEFAULT';
my($numFields, $names, $types, @rows) = eval { $rdbh->table_info(@_) };
return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
my $sth = DBI::_new_sth($dbh, {
@@ -395,6 +400,7 @@
sub type_info_all {
my $dbh = shift;
+ local $SIG{__DIE__} = 'DEFAULT';
my $result = eval { $dbh->{'proxy_dbh'}->type_info_all(@_) };
return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
return $result;
@@ -450,6 +456,7 @@
my ($numRows, @outData);
+ local $SIG{__DIE__} = 'DEFAULT';
if ( $proto_ver > 1 ) {
($numRows, @outData) = eval { $rsth->execute($params, $proto_ver) };
return DBD::Proxy::proxy_set_err($sth, $@) if $@;
@@ -527,6 +534,7 @@
die "Attempt to fetch row without execute";
}
my $num_rows = $sth->FETCH('RowCacheSize') || 20;
+ local $SIG{__DIE__} = 'DEFAULT';
my @rows = eval { $rsth->fetch($num_rows) };
return DBD::Proxy::proxy_set_err($sth, $@) if $@;
unless (@rows == $num_rows) {
@@ -559,6 +567,7 @@
? $sth->{'proxy_no_finish'}
: $sth->FETCH('Database')->{'proxy_no_finish'};
unless ($no_finish) {
+ local $SIG{__DIE__} = 'DEFAULT';
my $result = eval { $rsth->finish() };
return DBD::Proxy::proxy_set_err($sth, $@) if $@;
return $result;
@@ -581,6 +590,7 @@
if ($type eq 'remote') {
my $rsth = $sth->{'proxy_sth'} or return undef;
+ local $SIG{__DIE__} = 'DEFAULT';
my $result = eval { $rsth->STORE($attr => $val) };
return DBD::Proxy::proxy_set_err($sth, $@) if ($@);
return $result;
@@ -610,6 +620,7 @@
if ($type ne 'local') {
my $rsth = $sth->{'proxy_sth'} or return undef;
+ local $SIG{__DIE__} = 'DEFAULT';
my $result = eval { $rsth->FETCH($attr) };
return DBD::Proxy::proxy_set_err($sth, $@) if $@;
return $result;
------------------------- Cut Here ------------------------------
--- ProxyServer.pm.orig Fri Sep 13 18:40:21 2002
+++ ProxyServer.pm Tue Sep 17 13:20:02 2002
@@ -220,7 +220,7 @@
my $msg = $@;
undef $dbh->{'private_server'};
if ($msg) {
- $server->Error($msg);
+ $server->Debug("CallMethod died with: $@");
die $msg;
} else {
$server->Debug("CallMethod: <= " . join(",", @result));
--
----------------------------------------------------------------
Steven N. Hirsch tie-line: 446-6557 ext: 802-769-6557
Staff Engineer Methodology Integration Team
ASIC Product Development IBM Microelectronics
----------------------------------------------------------------
