X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FTxnScopeGuard.pm;h=edf72057f280688edf67765def5f9e0f9393ab67;hb=a6543cfa5769989102af82b5308e23a4ebd3d24d;hp=04978f93a3816706a39f841fcd2e757e2e6126e7;hpb=1bc193ac4c3bb934d1877e49bf7c465fc82815d6;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm index 04978f9..edf7205 100644 --- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm +++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm @@ -2,25 +2,113 @@ package DBIx::Class::Storage::TxnScopeGuard; use strict; use warnings; +use Try::Tiny; +use Scalar::Util qw(weaken blessed refaddr); +use DBIx::Class; +use DBIx::Class::_Util qw(is_exception detected_reinvoked_destructor); +use DBIx::Class::Carp; +use namespace::clean; sub new { my ($class, $storage) = @_; + my $guard = { + inactivated => 0, + storage => $storage, + }; + + # 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 + # + # 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... + if (is_exception $@) { + weaken( + $guard->{existing_exception_ref} = (ref($@) eq '') ? \$@ : $@ + ); + } + $storage->txn_begin; - bless [ 0, $storage ], ref $class || $class; + + weaken( $guard->{dbh} = $storage->_dbh ); + + bless $guard, ref $class || $class; + + $guard; } sub commit { my $self = shift; - $self->[1]->txn_commit; - $self->[0] = 1; + $self->{storage}->throw_exception("Refusing to execute multiple commits on scope guard $self") + if $self->{inactivated}; + + $self->{storage}->txn_commit; + $self->{inactivated} = 1; } sub DESTROY { - my ($dismiss, $storage) = @{$_[0]}; + return if &detected_reinvoked_destructor; + + my $self = shift; - $storage->txn_rollback unless $dismiss; + 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}; + + my $exception = $@ if ( + is_exception $@ + and + ( + ! defined $self->{existing_exception_ref} + or + refaddr( ref($@) eq '' ? \$@ : $@ ) != refaddr($self->{existing_exception_ref}) + ) + ); + + { + 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" + ); + } + } + } + + $@ = $exception; } 1; @@ -29,7 +117,7 @@ __END__ =head1 NAME -DBIx::Class::Storage::TxnScopeGuard +DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling =head1 SYNOPSIS @@ -46,20 +134,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 @@ -67,13 +156,15 @@ the transaction is rolled back. L. -=head1 AUTHOR +L by chocolateboy (inspiration for this module) -Ash Berlin, 2008. +=head1 FURTHER QUESTIONS? -Insipred 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.