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
16 *IS_BROKEN_PERL = sub () { 0 };
18 elsif ($] < 5.013008) {
19 *IS_BROKEN_PERL = sub () { 1 };
22 die 'The $@ debacle should have been resolved by now, adjust DBIC';
26 my ($guards_count, $compat_handler, $foreign_handler);
29 my ($class, $storage) = @_;
32 my $guard = bless [ 0, $storage, $storage->_dbh ], ref $class || $class;
35 # install a callback carefully
36 if (IS_BROKEN_PERL and !$guards_count) {
38 # if the thrown exception is a plain string, wrap it in our
40 # this is actually a pretty cool idea, may very well keep it
42 $compat_handler ||= bless(
44 $@ = (blessed($_[0]) or ref($_[0]))
46 : bless ( { msg => $_[0] }, 'DBIx::Class::Exception')
50 '__TxnScopeGuard__FIXUP__',
53 if ($foreign_handler = $SIG{__DIE__}) {
54 $SIG{__DIE__} = bless (
56 # we trust the foreign handler to do whatever it wants, all we do is set $@
57 eval { $compat_handler->(@_) };
58 $foreign_handler->(@_);
60 '__TxnScopeGuard__FIXUP__',
64 $SIG{__DIE__} = $compat_handler;
77 $self->[1]->txn_commit;
82 my ($dismiss, $storage) = @{$_[0]};
86 # don't touch unless it's ours, and there are no more of us left
93 if (ref $SIG{__DIE__} eq '__TxnScopeGuard__FIXUP__') {
94 # restore what we saved
95 if ($foreign_handler) {
96 $SIG{__DIE__} = $foreign_handler;
103 # make sure we do not leak the foreign one in case it exists
104 undef $foreign_handler;
109 # if our dbh is not ours anymore, the weakref will go undef
110 $storage->_preserve_foreign_dbh;
111 return unless $_[0]->[2];
118 carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
121 my $rollback_exception;
122 # do minimal connectivity check due to weird shit like
123 # https://rt.cpan.org/Public/Bug/Display.html?id=62370
124 try { $storage->_seems_connected && $storage->txn_rollback }
125 catch { $rollback_exception = shift };
127 if (defined $rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) {
128 # append our text - THIS IS A TEMPORARY FIXUP!
129 # a real stackable exception object is in the works
130 if (ref $exception eq 'DBIx::Class::Exception') {
131 $exception->{msg} = "Transaction aborted: $exception->{msg} "
132 ."Rollback failed: ${rollback_exception}";
135 $exception = "Transaction aborted: ${exception} "
136 ."Rollback failed: ${rollback_exception}";
140 "********************* ROLLBACK FAILED!!! ********************",
141 "\nA rollback operation failed after the guard went out of scope.",
142 'This is potentially a disastrous situation, check your data for',
143 "consistency: $rollback_exception"
149 $@ = $exception unless IS_BROKEN_PERL;
158 DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling
163 my ($self, $schema) = @_;
165 my $guard = $schema->txn_scope_guard;
167 # Multiple database operations here
174 An object that behaves much like L<Scope::Guard>, but hardcoded to do the
175 right thing with transactions in DBIx::Class.
181 Creating an instance of this class will start a new transaction (by
182 implicitly calling L<DBIx::Class::Storage/txn_begin>. Expects a
183 L<DBIx::Class::Storage> object as its only argument.
187 Commit the transaction, and stop guarding the scope. If this method is not
188 called and this object goes out of scope (e.g. an exception is thrown) then
189 the transaction is rolled back, via L<DBIx::Class::Storage/txn_rollback>
195 L<DBIx::Class::Schema/txn_scope_guard>.
201 Inspired by L<Scope::Guard> by chocolateboy.
203 This module is free software. It may be used, redistributed and/or modified
204 under the same terms as Perl itself.