Fix "current rs is always first in from" brainfart introduced in 893403c81
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / TxnScopeGuard.pm
1 package DBIx::Class::Storage::TxnScopeGuard;
2
3 use strict;
4 use warnings;
5 use Try::Tiny;
6 use Scalar::Util qw/weaken blessed refaddr/;
7 use DBIx::Class;
8 use DBIx::Class::Carp;
9 use namespace::clean;
10
11 sub new {
12   my ($class, $storage) = @_;
13
14   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   if (defined $@ and $@ ne '') {
27     weaken(
28       $guard->{existing_exception_ref} = (ref $@ ne '') ? $@ : \$@
29     );
30   }
31
32   $storage->txn_begin;
33
34   weaken( $guard->{dbh} = $storage->_dbh );
35
36   bless $guard, ref $class || $class;
37
38   $guard;
39 }
40
41 sub commit {
42   my $self = shift;
43
44   $self->{storage}->throw_exception("Refusing to execute multiple commits on scope guard $self")
45     if $self->{inactivated};
46
47   $self->{storage}->txn_commit;
48   $self->{inactivated} = 1;
49 }
50
51 sub DESTROY {
52   my $self = shift;
53
54   return if $self->{inactivated};
55
56   # if our dbh is not ours anymore, the $dbh weakref will go undef
57   $self->{storage}->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
58   return unless $self->{dbh};
59
60   my $exception = $@ if (
61     defined $@
62       and
63     $@ ne ''
64       and
65     (
66       ! defined $self->{existing_exception_ref}
67         or
68       refaddr( ref $@ eq '' ? \$@ : $@ ) != refaddr($self->{existing_exception_ref})
69     )
70   );
71
72   {
73     local $@;
74
75     carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
76       unless defined $exception;
77
78     my $rollback_exception;
79     # do minimal connectivity check due to weird shit like
80     # https://rt.cpan.org/Public/Bug/Display.html?id=62370
81     try { $self->{storage}->_seems_connected && $self->{storage}->txn_rollback }
82     catch { $rollback_exception = shift };
83
84     if ( $rollback_exception and (
85       ! defined blessed $rollback_exception
86           or
87       ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION')
88     ) ) {
89       # append our text - THIS IS A TEMPORARY FIXUP!
90       # a real stackable exception object is in the works
91       if (ref $exception eq 'DBIx::Class::Exception') {
92         $exception->{msg} = "Transaction aborted: $exception->{msg} "
93           ."Rollback failed: ${rollback_exception}";
94       }
95       elsif ($exception) {
96         $exception = "Transaction aborted: ${exception} "
97           ."Rollback failed: ${rollback_exception}";
98       }
99       else {
100         carp (join ' ',
101           "********************* ROLLBACK FAILED!!! ********************",
102           "\nA rollback operation failed after the guard went out of scope.",
103           'This is potentially a disastrous situation, check your data for',
104           "consistency: $rollback_exception"
105         );
106       }
107     }
108   }
109
110   $@ = $exception;
111 }
112
113 1;
114
115 __END__
116
117 =head1 NAME
118
119 DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling
120
121 =head1 SYNOPSIS
122
123  sub foo {
124    my ($self, $schema) = @_;
125
126    my $guard = $schema->txn_scope_guard;
127
128    # Multiple database operations here
129
130    $guard->commit;
131  }
132
133 =head1 DESCRIPTION
134
135 An object that behaves much like L<Scope::Guard>, but hardcoded to do the
136 right thing with transactions in DBIx::Class.
137
138 =head1 METHODS
139
140 =head2 new
141
142 Creating an instance of this class will start a new transaction (by
143 implicitly calling L<DBIx::Class::Storage/txn_begin>. Expects a
144 L<DBIx::Class::Storage> object as its only argument.
145
146 =head2 commit
147
148 Commit the transaction, and stop guarding the scope. If this method is not
149 called and this object goes out of scope (e.g. an exception is thrown) then
150 the transaction is rolled back, via L<DBIx::Class::Storage/txn_rollback>
151
152 =cut
153
154 =head1 SEE ALSO
155
156 L<DBIx::Class::Schema/txn_scope_guard>.
157
158 =head1 AUTHOR
159
160 Ash Berlin, 2008.
161
162 Inspired by L<Scope::Guard> by chocolateboy.
163
164 This module is free software. It may be used, redistributed and/or modified
165 under the same terms as Perl itself.
166
167 =cut