From: Peter Rabbitson Date: Mon, 29 Jul 2013 01:47:13 +0000 (+0200) Subject: Make the dbh error handler installer `Perl -d` friendly X-Git-Tag: v0.08260~122 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=5bd3dbd48018c19c5204c6183469b62545b30055 Make the dbh error handler installer `Perl -d` friendly GC in perl is a mess sometimes - a literal sub { ... } within a try { ... } goes wonky, but the equivalent coderef stored in a scalar is fine >.< --- diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index fc4a4fb..208f962 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1386,6 +1386,29 @@ sub _connect { local $DBI::connect_via = 'connect' if $INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}; + # this odd anonymous coderef dereference is in fact really + # necessary to avoid the unwanted effect described in perl5 + # RT#75792 + # + # in addition the coderef itself can't reside inside the try{} block below + # as it somehow triggers a leak under perl -d + my $dbh_error_handler_installer = sub { + weaken (my $weak_self = $_[0]); + + # the coderef is blessed so we can distinguish it from externally + # supplied handles (which must be preserved) + $_[1]->{HandleError} = bless 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 + DBIx::Class::Exception->throw("DBI Exception (unhandled by DBIC, ::Schema GCed): $_[0]"); + } + }, '__DBIC__DBH__ERROR__HANDLER__'; + }; + try { if(ref $info[0] eq 'CODE') { $dbh = $info[0]->(); @@ -1429,26 +1452,7 @@ sub _connect { $dbh->{RaiseError} = 1; } - # 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; - - # the coderef is blessed so we can distinguish it from externally - # supplied handles (which must be preserved) - $_[1]->{HandleError} = bless 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 - DBIx::Class::Exception->throw("DBI Exception (unhandled by DBIC, ::Schema GCed): $_[0]"); - } - }, '__DBIC__DBH__ERROR__HANDLER__'; - }->($self, $dbh); + $dbh_error_handler_installer->($self, $dbh); } } catch {