1 package DBIx::Class::Storage::TxnScopeGuard;
5 use Carp::Clan qw/^DBIx::Class/;
7 use Scalar::Util qw/weaken blessed/;
8 use DBIx::Class::Exception;
11 # temporary until we fix the $@ issue in core
12 # we also need a real appendable, stackable exception object
15 if ($] >= 5.013001 and $] <= 5.013007) {
16 *IS_BROKEN_PERL = sub () { 1 };
19 *IS_BROKEN_PERL = sub () { 0 };
23 my ($guards_count, $compat_handler, $foreign_handler);
26 my ($class, $storage) = @_;
29 my $guard = bless [ 0, $storage, $storage->_dbh ], ref $class || $class;
32 # install a callback carefully
33 if (IS_BROKEN_PERL and !$guards_count) {
35 # if the thrown exception is a plain string, wrap it in our
37 # this is actually a pretty cool idea, may very well keep it
39 $compat_handler ||= bless(
41 $@ = (blessed($_[0]) or ref($_[0]))
43 : bless ( { msg => $_[0] }, 'DBIx::Class::Exception')
47 '__TxnScopeGuard__FIXUP__',
50 if ($foreign_handler = $SIG{__DIE__}) {
51 $SIG{__DIE__} = bless (
53 # we trust the foreign handler to do whatever it wants, all we do is set $@
54 eval { $compat_handler->(@_) };
55 $foreign_handler->(@_);
57 '__TxnScopeGuard__FIXUP__',
61 $SIG{__DIE__} = $compat_handler;
74 $self->[1]->txn_commit;
79 my ($dismiss, $storage) = @{$_[0]};
83 # don't touch unless it's ours, and there are no more of us left
90 if (ref $SIG{__DIE__} eq '__TxnScopeGuard__FIXUP__') {
91 # restore what we saved
92 if ($foreign_handler) {
93 $SIG{__DIE__} = $foreign_handler;
100 # make sure we do not leak the foreign one in case it exists
101 undef $foreign_handler;
106 # if our dbh is not ours anymore, the weakref will go undef
107 $storage->_verify_pid;
108 return unless $_[0]->[2];
115 carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
118 my $rollback_exception;
119 # do minimal connectivity check due to weird shit like
120 # https://rt.cpan.org/Public/Bug/Display.html?id=62370
121 try { $storage->_seems_connected && $storage->txn_rollback }
122 catch { $rollback_exception = shift };
124 if (defined $rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) {
125 # append our text - THIS IS A TEMPORARY FIXUP!
126 # a real stackable exception object is in the works
127 if (ref $exception eq 'DBIx::Class::Exception') {
128 $exception->{msg} = "Transaction aborted: $exception->{msg} "
129 ."Rollback failed: ${rollback_exception}";
132 $exception = "Transaction aborted: ${exception} "
133 ."Rollback failed: ${rollback_exception}";
137 "********************* ROLLBACK FAILED!!! ********************",
138 "\nA rollback operation failed after the guard went out of scope.",
139 'This is potentially a disastrous situation, check your data for',
140 "consistency: $rollback_exception"
146 $@ = $exception unless IS_BROKEN_PERL;
155 DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling
160 my ($self, $schema) = @_;
162 my $guard = $schema->txn_scope_guard;
164 # Multiple database operations here
171 An object that behaves much like L<Scope::Guard>, but hardcoded to do the
172 right thing with transactions in DBIx::Class.
178 Creating an instance of this class will start a new transaction (by
179 implicitly calling L<DBIx::Class::Storage/txn_begin>. Expects a
180 L<DBIx::Class::Storage> object as its only argument.
184 Commit the transaction, and stop guarding the scope. If this method is not
185 called and this object goes out of scope (e.g. an exception is thrown) then
186 the transaction is rolled back, via L<DBIx::Class::Storage/txn_rollback>
192 L<DBIx::Class::Schema/txn_scope_guard>.
198 Inspired by L<Scope::Guard> by chocolateboy.
200 This module is free software. It may be used, redistributed and/or modified
201 under the same terms as Perl itself.