X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FTxnScopeGuard.pm;h=0979a2660d6998a07bd2b4d2a699870769a2e31d;hb=64b3598fcf53fcec068a67277d80363540f19427;hp=56c8c8117e1ec23a12b3d2b849129677d31d35fb;hpb=9c1700e39e6ee002d9294c0d988882d1f0d7d86f;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm index 56c8c81..0979a26 100644 --- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm +++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm @@ -2,23 +2,11 @@ package DBIx::Class::Storage::TxnScopeGuard; use strict; use warnings; -use Carp::Clan qw/^DBIx::Class/; use Try::Tiny; use Scalar::Util qw/weaken blessed/; +use DBIx::Class; use DBIx::Class::Exception; - -# temporary until we fix the $@ issue in core -# we also need a real appendable, stackable exception object -# (coming soon) -BEGIN { - if ($] >= 5.013001 and $] <= 5.013007) { - *IS_BROKEN_PERL = sub () { 1 }; - } - else { - *IS_BROKEN_PERL = sub () { 0 }; - } -} - +use DBIx::Class::Carp; use namespace::clean; my ($guards_count, $compat_handler, $foreign_handler); @@ -31,7 +19,7 @@ sub new { # install a callback carefully - if (IS_BROKEN_PERL and !$guards_count) { + if (DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT and !$guards_count) { # if the thrown exception is a plain string, wrap it in our # own exception class @@ -83,7 +71,7 @@ sub DESTROY { # don't touch unless it's ours, and there are no more of us left if ( - IS_BROKEN_PERL + DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT and !$guards_count ) { @@ -122,7 +110,11 @@ sub DESTROY { try { $storage->_seems_connected && $storage->txn_rollback } catch { $rollback_exception = shift }; - if (defined $rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) { + if ( $rollback_exception and ( + ! defined blessed $rollback_exception + or + ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION') + ) ) { # append our text - THIS IS A TEMPORARY FIXUP! # a real stackable exception object is in the works if (ref $exception eq 'DBIx::Class::Exception') { @@ -144,7 +136,7 @@ sub DESTROY { } } - $@ = $exception unless IS_BROKEN_PERL; + $@ = $exception unless DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT; } 1;