File Coverage

blib/lib/DBIx/Class/Storage/TxnScopeGuard.pm
Criterion Covered Total %
statement 42 42 100.0
branch 19 20 95.0
condition 8 12 66.6
subroutine 10 10 100.0
pod 2 2 100.0
total 81 86 94.1


line stmt bran cond sub pod time code
1             package DBIx::Class::Storage::TxnScopeGuard;
2              
3 234     234   2212 use strict;
  234         617  
  234         7070  
4 234     234   1300 use warnings;
  234         546  
  234         7032  
5 234     234   1308 use Scalar::Util qw(weaken blessed refaddr);
  234         544  
  234         12003  
6 234     234   1516 use DBIx::Class;
  234         682  
  234         10359  
7 234     234   1490 use DBIx::Class::_Util qw(is_exception detected_reinvoked_destructor);
  234         533  
  234         11199  
8 234     234   1464 use DBIx::Class::Carp;
  234         579  
  234         2014  
9 234     234   1516 use namespace::clean;
  234         598  
  234         2010  
10              
11             sub new {
12 9058     9058 1 22046 my ($class, $storage) = @_;
13              
14 9058         30013 my $guard = {
15             inactivated => 0,
16             storage => $storage,
17             };
18              
19             # we are starting with an already set $@ - in order for things to work we need to
20             # be able to recognize it upon destruction - store its weakref
21             # recording it before doing the txn_begin stuff
22             #
23             # FIXME FRAGILE - any eval that fails but *does not* rethrow between here
24             # and the unwind will trample over $@ and invalidate the entire mechanism
25             # There got to be a saner way of doing this...
26             #
27             # Deliberately *NOT* using is_exception - if someone left a misbehaving
28             # antipattern value in $@, it's not our business to whine about it
29             weaken(
30 9058 100 66     43723 $guard->{existing_exception_ref} = (length ref $@) ? $@ : \$@
    100          
31             ) if( defined $@ and length $@ );
32              
33 9058         210428 $storage->txn_begin;
34              
35 9058         48528 weaken( $guard->{dbh} = $storage->_dbh );
36              
37 9058   33     38464 bless $guard, ref $class || $class;
38              
39 9058         30168 $guard;
40             }
41              
42             sub commit {
43 8909     8909 1 21508 my $self = shift;
44              
45             $self->{storage}->throw_exception("Refusing to execute multiple commits on scope guard $self")
46 8909 50       24203 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 8909         17165 $self->{inactivated} = 1;
54 8909         30482 $self->{storage}->txn_commit;
55             }
56              
57             sub DESTROY {
58 9059 100   9059   29247 return if &detected_reinvoked_destructor;
59              
60 9058 100       143753 return if $_[0]->{inactivated};
61              
62              
63             # grab it before we've done volatile stuff below
64             my $current_exception = (
65             is_exception $@
66             and
67             (
68             ! defined $_[0]->{existing_exception_ref}
69             or
70             refaddr( (length ref $@) ? $@ : \$@ ) != refaddr($_[0]->{existing_exception_ref})
71 149 100 66     739 )
72             )
73             ? $@
74             : undef
75             ;
76              
77              
78             # if our dbh is not ours anymore, the $dbh weakref will go undef
79 149         984 $_[0]->{storage}->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
80 149 100       1041 return unless defined $_[0]->{dbh};
81              
82              
83 137 100       545 carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back'
84             unless defined $current_exception;
85              
86              
87 137 100 100     1197 if (
    100          
88             my $rollback_exception = $_[0]->{storage}->__delicate_rollback(
89             defined $current_exception
90             ? \$current_exception
91             : ()
92             )
93             and
94             ! defined $current_exception
95             ) {
96 4         28 carp (join ' ',
97             "********************* ROLLBACK FAILED!!! ********************",
98             "\nA rollback operation failed after the guard went out of scope.",
99             'This is potentially a disastrous situation, check your data for',
100             "consistency: $rollback_exception"
101             );
102             }
103              
104 137         391 $@ = $current_exception
105             if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
106              
107             # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
108             # collected before leaving this scope. Depending on the code above, this
109             # may very well be just a preventive measure guarding future modifications
110 137         1145 undef;
111             }
112              
113             1;
114              
115             __END__