DBIO
view release on metacpan or search on metacpan
lib/DBIO/Storage/TxnScopeGuard.pm view on Meta::CPAN
package DBIO::Storage::TxnScopeGuard;
# ABSTRACT: Scope-based transaction handling
use strict;
use warnings;
use Try::Tiny;
use Scalar::Util qw(weaken blessed refaddr);
use DBIO;
use DBIO::Util qw(is_exception is_windows);
use DBIO::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;
weaken( $guard->{dbh} = $storage->_dbh );
bless $guard, ref $class || $class;
$guard;
}
sub commit {
my $self = shift;
$self->{storage}->throw_exception("Refusing to execute multiple commit/rollbacks on scope guard $self")
if $self->{inactivated};
# 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 rollback {
my $self = shift;
$self->{storage}->throw_exception("Refusing to execute multiple commit/rollbacks on scope guard $self")
if $self->{inactivated};
$self->{inactivated} = 1;
$self->{storage}->txn_rollback;
}
sub DESTROY {
my $self = shift;
if ($self->{_destroy_invoked}++) {
carp 'Preventing *MULTIPLE* DESTROY() invocations on DBIO::Storage::TxnScopeGuard';
return;
}
return if $self->{inactivated};
$self->{inactivated} = 1;
# if our dbh is not ours anymore, the $dbh weakref will go undef
$self->{storage}->_verify_pid unless is_windows;
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 $@;
( run in 1.132 second using v1.01-cache-2.11-cpan-995e09ba956 )