X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FTxnScopeGuard.pm;h=111621b1896745548efe49bd936f1c2b4d32d1ba;hb=118b2c36ae7a9174ecc4b22e1fa2c91f8e56dead;hp=d8ab75cda0c5e76e5ee0c1354b21bddd4d3cc379;hpb=0d8817bcb744bb46adf787f359f34e49b092d42e;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm index d8ab75c..111621b 100644 --- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm +++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm @@ -2,15 +2,12 @@ package DBIx::Class::Storage::TxnScopeGuard; use strict; use warnings; -use Try::Tiny; -use Scalar::Util qw/weaken blessed refaddr/; +use Scalar::Util qw(weaken blessed refaddr); use DBIx::Class; -use DBIx::Class::Exception; +use DBIx::Class::_Util qw(is_exception detected_reinvoked_destructor); use DBIx::Class::Carp; use namespace::clean; -my ($guards_count, $compat_handler, $foreign_handler); - sub new { my ($class, $storage) = @_; @@ -22,53 +19,25 @@ sub new { # we are starting with an already set $@ - in order for things to work we need to # be able to recognize it upon destruction - store its weakref # recording it before doing the txn_begin stuff - if (defined $@ and $@ ne '') { - $guard->{existing_exception_ref} = (ref $@ ne '') ? $@ : \$@; - weaken $guard->{existing_exception_ref}; + # + # FIXME FRAGILE - any eval that fails but *does not* rethrow between here + # and the unwind will trample over $@ and invalidate the entire mechanism + # There got to be a saner way of doing this... + # + # Deliberately *NOT* using is_exception - if someone left a misbehaving + # antipattern value in $@, it's not our business to whine about it + if( defined $@ and length $@ ) { + weaken( + $guard->{existing_exception_ref} = (length ref $@) ? $@ : \$@ + ); } $storage->txn_begin; - $guard->{dbh} = $storage->_dbh; - weaken $guard->{dbh}; + weaken( $guard->{dbh} = $storage->_dbh ); bless $guard, ref $class || $class; - # install a callback carefully - 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 - # 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++; - $guard; } @@ -78,93 +47,64 @@ sub commit { $self->{storage}->throw_exception("Refusing to execute multiple commits on scope guard $self") if $self->{inactivated}; - $self->{storage}->txn_commit; + # FIXME - this assumption may be premature: a commit may fail and a rollback + # *still* be necessary. Currently I am not aware of such scenarious, but I + # also know the deferred constraint handling is *severely* undertested. + # Making the change of "fire txn and never come back to this" in order to + # address RT#107159, but this *MUST* be reevaluated later. $self->{inactivated} = 1; + $self->{storage}->txn_commit; } sub DESTROY { - my $self = shift; + return if &detected_reinvoked_destructor; - $guards_count--; + return if $_[0]->{inactivated}; - # don't touch unless it's ours, and there are no more of us left - if ( - DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT - 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; - } + # grab it before we've done volatile stuff below + my $current_exception = ( + is_exception $@ + and + ( + ! defined $_[0]->{existing_exception_ref} + or + refaddr( (length ref $@) ? $@ : \$@ ) != refaddr($_[0]->{existing_exception_ref}) + ) + ) + ? $@ + : undef + ; - return if $self->{inactivated}; # if our dbh is not ours anymore, the $dbh weakref will go undef - $self->{storage}->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK; - return unless $self->{dbh}; + $_[0]->{storage}->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK; + return unless defined $_[0]->{dbh}; - my $exception = $@ if ( - defined $@ - and - $@ ne '' - and - ( - ! defined $self->{existing_exception_ref} - or - refaddr( ref $@ eq '' ? \$@ : $@ ) != refaddr($self->{existing_exception_ref}) + + carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back' + unless defined $current_exception; + + + if ( + my $rollback_exception = $_[0]->{storage}->__delicate_rollback( + defined $current_exception + ? \$current_exception + : () ) - ); - - { - local $@; - - carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.' - unless defined $exception; - - my $rollback_exception; - # do minimal connectivity check due to weird shit like - # https://rt.cpan.org/Public/Bug/Display.html?id=62370 - try { $self->{storage}->_seems_connected && $self->{storage}->txn_rollback } - catch { $rollback_exception = shift }; - - 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') { - $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" - ); - } - } + and + ! defined $current_exception + ) { + 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 DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT; + $@ = $current_exception + if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT; } 1; @@ -212,13 +152,15 @@ the transaction is rolled back, via L L. -=head1 AUTHOR +L by chocolateboy (inspiration for this module) -Ash Berlin, 2008. +=head1 FURTHER QUESTIONS? -Inspired by L by chocolateboy. +Check the list of L. -This module is free software. It may be used, redistributed and/or modified -under the same terms as Perl itself. +=head1 COPYRIGHT AND LICENSE -=cut +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L.