File Coverage

blib/lib/DBIx/Class/Storage/TxnScopeGuard.pm
Criterion Covered Total %
statement 54 55 98.1
branch 21 24 87.5
condition 9 15 60.0
subroutine 13 13 100.0
pod 2 2 100.0
total 99 109 90.8


line stmt bran cond sub pod time code
1             package DBIx::Class::Storage::TxnScopeGuard;
2              
3 267     267   1687 use strict;
  267         598  
  267         7430  
4 267     267   1040 use warnings;
  267         577  
  267         6894  
5 267     267   1090 use Try::Tiny;
  267         515  
  267         14614  
6 267     267   1204 use Scalar::Util qw(weaken blessed refaddr);
  267         561  
  267         11901  
7 267     267   1227 use DBIx::Class;
  267         590  
  267         11200  
8 267     267   1195 use DBIx::Class::_Util qw(is_exception detected_reinvoked_destructor);
  267         550  
  267         12956  
9 267     267   1237 use DBIx::Class::Carp;
  267         508  
  267         2084  
10 267     267   1373 use namespace::clean;
  267         687  
  267         2474  
11              
12             sub new {
13 8940     8940 1 11067 my ($class, $storage) = @_;
14              
15 8940         22604 my $guard = {
16             inactivated => 0,
17             storage => $storage,
18             };
19              
20             # we are starting with an already set $@ - in order for things to work we need to
21             # be able to recognize it upon destruction - store its weakref
22             # recording it before doing the txn_begin stuff
23             #
24             # FIXME FRAGILE - any eval that fails but *does not* rethrow between here
25             # and the unwind will trample over $@ and invalidate the entire mechanism
26             # There got to be a saner way of doing this...
27 8940 100       23870 if (is_exception $@) {
28             weaken(
29 594 100       1967 $guard->{existing_exception_ref} = (ref($@) eq '') ? \$@ : $@
30             );
31             }
32              
33 8940         185002 $storage->txn_begin;
34              
35 8940         30112 weaken( $guard->{dbh} = $storage->_dbh );
36              
37 8940   33     33055 bless $guard, ref $class || $class;
38              
39 8940         21973 $guard;
40             }
41              
42             sub commit {
43 8807     8807 1 9973 my $self = shift;
44              
45             $self->{storage}->throw_exception("Refusing to execute multiple commits on scope guard $self")
46 8807 50       17702 if $self->{inactivated};
47              
48             # FIXME - this assumption may be premature: a commit may fail and a rollback
49             # *still* be necessary. Currently I am not aware of such scenarious, but I
50             # also know the deferred constraint handling is *severely* undertested.
51             # Making the change of "fire txn and never come back to this" in order to
52             # address RT#107159, but this *MUST* be reevaluated later.
53 8807         9797 $self->{inactivated} = 1;
54 8807         23465 $self->{storage}->txn_commit;
55             }
56              
57             sub DESTROY {
58 8941 100   8941   21616 return if &detected_reinvoked_destructor;
59              
60 8940         10543 my $self = shift;
61              
62 8940 100       130572 return if $self->{inactivated};
63              
64             # if our dbh is not ours anymore, the $dbh weakref will go undef
65 133         868 $self->{storage}->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
66 133 100       886 return unless $self->{dbh};
67              
68             my $exception = $@ if (
69             is_exception $@
70             and
71             (
72             ! defined $self->{existing_exception_ref}
73             or
74             refaddr( ref($@) eq '' ? \$@ : $@ ) != refaddr($self->{existing_exception_ref})
75 123 50 33     492 )
      66        
76             );
77              
78             {
79 123         178 local $@;
  123         228  
80              
81 123 100       459 carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
82             unless defined $exception;
83              
84 123         561 my $rollback_exception;
85             # do minimal connectivity check due to weird shit like
86             # https://rt.cpan.org/Public/Bug/Display.html?id=62370
87 123 100   123   9104 try { $self->{storage}->_seems_connected && $self->{storage}->txn_rollback }
88 123     6   1513 catch { $rollback_exception = shift };
  6         160  
89              
90 123 100 66     2495 if ( $rollback_exception and (
      100        
91             ! defined blessed $rollback_exception
92             or
93             ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION')
94             ) ) {
95             # append our text - THIS IS A TEMPORARY FIXUP!
96             # a real stackable exception object is in the works
97 5 50       37 if (ref $exception eq 'DBIx::Class::Exception') {
    100          
98 0         0 $exception->{msg} = "Transaction aborted: $exception->{msg} "
99             ."Rollback failed: ${rollback_exception}";
100             }
101             elsif ($exception) {
102 3         15 $exception = "Transaction aborted: ${exception} "
103             ."Rollback failed: ${rollback_exception}";
104             }
105             else {
106 2         14 carp (join ' ',
107             "********************* ROLLBACK FAILED!!! ********************",
108             "\nA rollback operation failed after the guard went out of scope.",
109             'This is potentially a disastrous situation, check your data for',
110             "consistency: $rollback_exception"
111             );
112             }
113             }
114             }
115              
116 123         985 $@ = $exception;
117             }
118              
119             1;
120              
121             __END__