From: Tim Bunce Sent: 20 January 2005 11:18
> On Wed, Jan 19, 2005 at 05:37:42PM -0000, Addison, Mark wrote:
> > Hello,
> >
> > I'm having a very strange problem with DBD::Proxy and have ended
> > up with brain meltdown - so now its your turn ;-)
>
> Here's a patch...
Excellent, thanks very much for the quick response Tim,
that's fixed it nicely.
Out of interest... I've realised what I missed was all the
work the dbi does when the localised AutoCommit goes out of
scope, which I guess is why the C<local $@> are needed.
I'm still a bit baffled by the
C<local $SIG{__DIE__} = 'DEFAULT'>.
Are they dealing with something specific or just playing safe?
cheers,
mark
>
> Tim.
>
>
> Index: t/80proxy.t
> ===================================================================
> --- t/80proxy.t (revision 623)
> +++ t/80proxy.t (working copy)
> @@ -1,4 +1,5 @@
> #!perl -w # -*- perl -*-
> +# vim:sw=4:ts=8
>
> require 5.004;
> use strict;
> @@ -70,7 +71,7 @@
> or die "Failed to create config file $config_file: $!";
>
> my($handle, $port);
> -my $numTests = 117;
> +my $numTests = 119;
> if (@ARGV) {
> $port = $ARGV[0];
> } else {
> @@ -118,10 +119,18 @@
> Test($dbh->{example_driver_path});
>
> print "Setting AutoCommit\n";
> +$@ = "old-error"; # should be preserved across DBI calls
> Test($dbh->{AutoCommit} = 1);
> Test($dbh->{AutoCommit});
> +Test($@ eq "old-error", "\$@ now '$@'");
> #$dbh->trace(2);
>
> +eval {
> + local $dbh->{ AutoCommit } = 1; # This breaks die!
> + die "BANG!!!\n";
> +};
> +Test($@ eq "BANG!!!\n", "\$@ value lost");
> +
> print "Doing a ping.\n";
> Test($dbh->ping);
>
> Index: lib/DBD/Proxy.pm
> ===================================================================
> --- lib/DBD/Proxy.pm (revision 633)
> +++ lib/DBD/Proxy.pm (working copy)
> @@ -237,7 +237,6 @@
> 'type' => $type,
> 'h' => "DBI::_::$type"
> );
> - local $SIG{__DIE__} = 'DEFAULT';
> my $method_code = UNIVERSAL::can($expand{'h'}, $method) ?
> q/package ~class~;
> sub ~method~ {
> @@ -260,8 +259,9 @@
> }
> /;
> $method_code =~ s/\~(\w+)\~/$expand{$1}/eg;
> - eval $method_code;
> - die $@ if $@;
> + local $SIG{__DIE__} = 'DEFAULT';
> + my $err = do { local $@; eval $method_code.2; $@ };
> + die $err if $err;
> goto &$AUTOLOAD;
> }
>
> @@ -307,6 +307,7 @@
>
> if ($type eq 'remote' || $type eq 'cached') {
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> 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';
> @@ -327,6 +328,7 @@
> return $dbh->SUPER::FETCH($attr) unless $type eq 'remote';
>
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> my $result = eval { $dbh->{'proxy_dbh'}->FETCH($attr) };
> return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
> return $result;
> @@ -346,6 +348,7 @@
> $sth->{'proxy_attr_cache'} = {cache_filled => 0};
> my $rdbh = $dbh->{'proxy_dbh'};
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> 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")
> @@ -384,6 +387,7 @@
> # for example.
> # Jochen
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> my $result = eval { $dbh->{'proxy_dbh'}->quote(@_) };
> return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
> return $result;
> @@ -394,6 +398,7 @@
> my $rdbh = $dbh->{'proxy_dbh'};
> #warn "table_info(@_)";
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> my($numFields, $names, $types, @rows) = eval {
> $rdbh->table_info(@_) };
> return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
> my ($sth, $inner) = DBI::_new_sth($dbh, {
> @@ -427,6 +432,7 @@
> sub type_info_all {
> my $dbh = shift;
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> my $result = eval { $dbh->{'proxy_dbh'}->type_info_all(@_) };
> return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
> return $result;
> @@ -478,6 +484,7 @@
> my ($numRows, @outData);
>
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> if ( $proto_ver > 1 ) {
> ($numRows, @outData) = eval { $rsth->execute($params,
> $proto_ver) };
> return DBD::Proxy::proxy_set_err($sth, $@) if $@;
> @@ -558,6 +565,7 @@
> }
> my $num_rows = $sth->FETCH('RowCacheSize') || 20;
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> my @rows = eval { $rsth->fetch($num_rows) };
> return DBD::Proxy::proxy_set_err($sth, $@) if $@;
> unless (@rows == $num_rows) {
> @@ -591,6 +599,7 @@
> : $sth->FETCH('Database')->{'proxy_no_finish'};
> unless ($no_finish) {
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> my $result = eval { $rsth->finish() };
> return DBD::Proxy::proxy_set_err($sth, $@) if $@;
> return $result;
> @@ -614,6 +623,7 @@
> if ($type eq 'remote') {
> my $rsth = $sth->{'proxy_sth'} or return undef;
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> my $result = eval { $rsth->STORE($attr => $val) };
> return DBD::Proxy::proxy_set_err($sth, $@) if ($@);
> return $result;
> @@ -644,6 +654,7 @@
> if ($type ne 'local') {
> my $rsth = $sth->{'proxy_sth'} or return undef;
> local $SIG{__DIE__} = 'DEFAULT';
> + local $@;
> my $result = eval { $rsth->FETCH($attr) };
> return DBD::Proxy::proxy_set_err($sth, $@) if $@;
> return $result;
>
>
This email (and any attachments) is intended solely for the individual(s) to
whom addressed.
It may contain confidential and/or legally privileged information.
Any statement or opinions therein are not necessarily those of ITN unless
specifically stated.
Any unauthorised use, disclosure or copying is prohibited.
If you have received this email in error, please notify the sender and delete
it from your system.
Security and reliability of the e-mail and attachments are not guaranteed.
You must take full responsibility for virus checking.
Independent Television News Limited,
Registered No. 548648 England,
VAT Reg. No: GB 756 2995 81,
200 Gray's Inn Road, London WC1X 8XZ,
Telephone: 020 7833 3000.
