From: Peter Rabbitson Date: Mon, 12 Jul 2010 02:55:25 +0000 (+0200) Subject: Rewrite the DBI connector to use Try::Tiny, avoid a leak by evoking a callback codere... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b720efd16eb1e747c3d12697f57edb708f67280a;hp=6c3e6bf62e7b21a233f9dea22b2228f1c4e2381a;p=dbsrgits%2FDBIx-Class-Historic.git Rewrite the DBI connector to use Try::Tiny, avoid a leak by evoking a callback coderef installer coderef :D --- diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 8aacfa1..9e4256c 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1166,9 +1166,7 @@ sub _connect { $DBI::connect_via = 'connect'; } - # FIXME - this should have been Try::Tiny, but triggers a leak-bug in perl(!) - # related to coderef refcounting. A failing test has been submitted to T::T - my $connect_ok = eval { + try { if(ref $info[0] eq 'CODE') { $dbh = $info[0]->(); } @@ -1181,32 +1179,37 @@ sub _connect { } unless ($self->unsafe) { - my $weak_self = $self; - weaken $weak_self; - $dbh->{HandleError} = sub { + + # this odd anonymous coderef dereference is in fact really + # necessary to avoid the unwanted effect described in perl5 + # RT#75792 + sub { + my $weak_self = $_[0]; + weaken $weak_self; + + $_[1]->{HandleError} = sub { if ($weak_self) { $weak_self->throw_exception("DBI Exception: $_[0]"); } else { # the handler may be invoked by something totally out of # the scope of DBIC - croak ("DBI Exception: $_[0]"); + croak ("DBI Exception (unhandled by DBIC, ::Schema GCed): $_[0]"); } - }; + }; + }->($self, $dbh); + $dbh->{ShowErrorStatement} = 1; $dbh->{RaiseError} = 1; $dbh->{PrintError} = 0; } - - 1; - }; - - my $possible_err = $@; - $DBI::connect_via = $old_connect_via if $old_connect_via; - - unless ($connect_ok) { - $self->throw_exception("DBI Connection failed: $possible_err") } + catch { + $self->throw_exception("DBI Connection failed: $_") + } + finally { + $DBI::connect_via = $old_connect_via if $old_connect_via; + }; $self->_dbh_autocommit($dbh->{AutoCommit}); $dbh; diff --git a/t/storage/error.t b/t/storage/error.t index e57d892..d3b28aa 100644 --- a/t/storage/error.t +++ b/t/storage/error.t @@ -11,10 +11,44 @@ use_ok( 'DBICTest::Schema' ); my $schema = DBICTest->init_schema; +my $e_start = quotemeta('DBIx::Class::'); + warnings_are ( sub { - throws_ok (sub { - $schema->resultset('CD')->create({ title => 'vacation in antarctica' }); - }, qr/NULL/); # as opposed to some other error + throws_ok ( + sub { + $schema->resultset('CD')->create({ title => 'vacation in antarctica' }) + }, + qr/$e_start.+constraint failed.+NULL/s + ); # as opposed to some other error }, [], 'No warnings besides exception' ); +my $dbh = $schema->storage->dbh; + +throws_ok ( + sub { + $dbh->do ('INSERT INTO nonexistent_table VALUES (1)') + }, + qr/$e_start.+DBI Exception.+no such table/, + 'DBI exceptions properly handled by dbic-installed callback' +); + +# destruction of everything except the $dbh should use the proper +# exception fallback: + +# FIXME +# These explicit disconnections on loss of $storage don't seem +# right... disable it here for the test anyway +{ + local $dbh->{Callbacks}{disconnect} = sub { 1 }; + + undef ($schema); + throws_ok ( + sub { + $dbh->do ('INSERT INTO nonexistent_table VALUES (1)') + }, + qr/DBI Exception.+unhandled by DBIC.+no such table/, + 'callback works after $schema is gone' + ); +} + done_testing;