X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FTxnScopeGuard.pm;h=4365b9d9622c4f619e22628541a86dc1f2c43614;hb=1f870d5a;hp=574587007a3c3d36a610f62e59064003be658934;hpb=a778f387401f12b9823aeab5afd200b3623d31a8;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm index 5745870..4365b9d 100644 --- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm +++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm @@ -1,14 +1,74 @@ -package # Hide from pause for now - till we get it working - DBIx::Class::Storage::TxnScopeGuard; +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::Exception; +use namespace::clean; + +# temporary until we fix the $@ issue in core +# we also need a real appendable, stackable exception object +# (coming soon) +BEGIN { + if ($] < 5.013001) { + *IS_BROKEN_PERL = sub () { 0 }; + } + elsif ($] < 5.013008) { + *IS_BROKEN_PERL = sub () { 1 }; + } + else { + die 'The $@ debacle should have been resolved by now, adjust DBIC'; + } +} + +my ($guards_count, $compat_handler, $foreign_handler); sub new { my ($class, $storage) = @_; $storage->txn_begin; - bless [ 0, $storage ], ref $class || $class; + my $guard = bless [ 0, $storage, $storage->_dbh ], ref $class || $class; + + + # install a callback carefully + if (IS_BROKEN_PERL and !$guards_count) { + + # if the thrown exception is a plain string, wrap it in our + # own exception class + # this is actually a pretty cool idea, may very well keep it + # after perl is fixed + $compat_handler ||= bless( + sub { + $@ = (blessed($_[0]) or ref($_[0])) + ? $_[0] + : bless ( { msg => $_[0] }, 'DBIx::Class::Exception') + ; + die; + }, + '__TxnScopeGuard__FIXUP__', + ); + + if ($foreign_handler = $SIG{__DIE__}) { + $SIG{__DIE__} = bless ( + sub { + # we trust the foreign handler to do whatever it wants, all we do is set $@ + eval { $compat_handler->(@_) }; + $foreign_handler->(@_); + }, + '__TxnScopeGuard__FIXUP__', + ); + } + else { + $SIG{__DIE__} = $compat_handler; + } + } + + $guards_count++; + + weaken ($guard->[2]); + $guard; } sub commit { @@ -18,33 +78,75 @@ sub commit { $self->[0] = 1; } -sub dismiss { - my $self = shift; - - $self->[0] = 1; -} - sub DESTROY { my ($dismiss, $storage) = @{$_[0]}; + $guards_count--; + + # don't touch unless it's ours, and there are no more of us left + if ( + IS_BROKEN_PERL + and + !$guards_count + ) { + + if (ref $SIG{__DIE__} eq '__TxnScopeGuard__FIXUP__') { + # restore what we saved + if ($foreign_handler) { + $SIG{__DIE__} = $foreign_handler; + } + else { + delete $SIG{__DIE__}; + } + } + + # make sure we do not leak the foreign one in case it exists + undef $foreign_handler; + } + return if $dismiss; + # if our dbh is not ours anymore, the weakref will go undef + $storage->_preserve_foreign_dbh; + return unless $_[0]->[2]; + my $exception = $@; - Carp::cluck("A DBIx::Class:: went out of scope without explicit commit/dismiss") - unless $exception; + { local $@; - eval { $storage->txn_rollback }; - my $rollback_exception = $@; - if($rollback_exception) { - my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION"; - - $storage->throw_exception( - "Transaction aborted: ${exception}. " - . "Rollback failed: ${rollback_exception}" - ) unless $rollback_exception =~ /$exception_class/; + + carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.' + unless $exception; + + my $rollback_exception; + # do minimal connectivity check due to weird shit like + # https://rt.cpan.org/Public/Bug/Display.html?id=62370 + try { $storage->_seems_connected && $storage->txn_rollback } + catch { $rollback_exception = shift }; + + if (defined $rollback_exception && $rollback_exception !~ /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') { + $exception->{msg} = "Transaction aborted: $exception->{msg} " + ."Rollback failed: ${rollback_exception}"; + } + elsif ($exception) { + $exception = "Transaction aborted: ${exception} " + ."Rollback failed: ${rollback_exception}"; + } + else { + carp (join ' ', + "********************* ROLLBACK FAILED!!! ********************", + "\nA rollback operation failed after the guard went out of scope.", + 'This is potentially a disastrous situation, check your data for', + "consistency: $rollback_exception" + ); + } } } + + $@ = $exception unless IS_BROKEN_PERL; } 1; @@ -53,7 +155,7 @@ __END__ =head1 NAME -DBIx::Class::Storage::TxnScopeGuard +DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling =head1 SYNOPSIS @@ -70,20 +172,21 @@ DBIx::Class::Storage::TxnScopeGuard =head1 DESCRIPTION An object that behaves much like L, but hardcoded to do the -right thing with transactions in DBIx::Class. +right thing with transactions in DBIx::Class. =head1 METHODS =head2 new -Creating an instance of this class will start a new transaction. Expects a +Creating an instance of this class will start a new transaction (by +implicitly calling L. Expects a L object as its only argument. =head2 commit Commit the transaction, and stop guarding the scope. If this method is not -called (i.e. an exception is thrown) and this object goes out of scope then -the transaction is rolled back. +called and this object goes out of scope (e.g. an exception is thrown) then +the transaction is rolled back, via L =cut @@ -95,7 +198,7 @@ L. Ash Berlin, 2008. -Insipred by L by chocolateboy. +Inspired by L by chocolateboy. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.