1 package DBIx::Class::Storage::TxnScopeGuard;
6 use Scalar::Util qw/weaken blessed/;
7 use DBIx::Class::Exception;
10 # temporary until we fix the $@ issue in core
11 # we also need a real appendable, stackable exception object
14 if ($] >= 5.013001 and $] <= 5.013007) {
15 *IS_BROKEN_PERL = sub () { 1 };
18 *IS_BROKEN_PERL = sub () { 0 };
24 my ($guards_count, $compat_handler, $foreign_handler);
27 my ($class, $storage) = @_;
30 my $guard = bless [ 0, $storage, $storage->_dbh ], ref $class || $class;
33 # install a callback carefully
34 if (IS_BROKEN_PERL and !$guards_count) {
36 # if the thrown exception is a plain string, wrap it in our
38 # this is actually a pretty cool idea, may very well keep it
40 $compat_handler ||= bless(
42 $@ = (blessed($_[0]) or ref($_[0]))
44 : bless ( { msg => $_[0] }, 'DBIx::Class::Exception')
48 '__TxnScopeGuard__FIXUP__',
51 if ($foreign_handler = $SIG{__DIE__}) {
52 $SIG{__DIE__} = bless (
54 # we trust the foreign handler to do whatever it wants, all we do is set $@
55 eval { $compat_handler->(@_) };
56 $foreign_handler->(@_);
58 '__TxnScopeGuard__FIXUP__',
62 $SIG{__DIE__} = $compat_handler;
75 $self->[1]->txn_commit;
80 my ($dismiss, $storage) = @{$_[0]};
84 # don't touch unless it's ours, and there are no more of us left
91 if (ref $SIG{__DIE__} eq '__TxnScopeGuard__FIXUP__') {
92 # restore what we saved
93 if ($foreign_handler) {
94 $SIG{__DIE__} = $foreign_handler;
101 # make sure we do not leak the foreign one in case it exists
102 undef $foreign_handler;
107 # if our dbh is not ours anymore, the weakref will go undef
108 $storage->_verify_pid;
109 return unless $_[0]->[2];
116 carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
119 my $rollback_exception;
120 # do minimal connectivity check due to weird shit like
121 # https://rt.cpan.org/Public/Bug/Display.html?id=62370
122 try { $storage->_seems_connected && $storage->txn_rollback }
123 catch { $rollback_exception = shift };
125 if (defined $rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) {
126 # append our text - THIS IS A TEMPORARY FIXUP!
127 # a real stackable exception object is in the works
128 if (ref $exception eq 'DBIx::Class::Exception') {
129 $exception->{msg} = "Transaction aborted: $exception->{msg} "
130 ."Rollback failed: ${rollback_exception}";
133 $exception = "Transaction aborted: ${exception} "
134 ."Rollback failed: ${rollback_exception}";
138 "********************* ROLLBACK FAILED!!! ********************",
139 "\nA rollback operation failed after the guard went out of scope.",
140 'This is potentially a disastrous situation, check your data for',
141 "consistency: $rollback_exception"
147 $@ = $exception unless IS_BROKEN_PERL;
156 DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling
161 my ($self, $schema) = @_;
163 my $guard = $schema->txn_scope_guard;
165 # Multiple database operations here
172 An object that behaves much like L<Scope::Guard>, but hardcoded to do the
173 right thing with transactions in DBIx::Class.
179 Creating an instance of this class will start a new transaction (by
180 implicitly calling L<DBIx::Class::Storage/txn_begin>. Expects a
181 L<DBIx::Class::Storage> object as its only argument.
185 Commit the transaction, and stop guarding the scope. If this method is not
186 called and this object goes out of scope (e.g. an exception is thrown) then
187 the transaction is rolled back, via L<DBIx::Class::Storage/txn_rollback>
193 L<DBIx::Class::Schema/txn_scope_guard>.
199 Inspired by L<Scope::Guard> by chocolateboy.
201 This module is free software. It may be used, redistributed and/or modified
202 under the same terms as Perl itself.