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/;
   7 use DBIx::Class;
   8 use DBIx::Class::Exception;
   9 use DBIx::Class::Carp;
  10 use namespace::clean;
  11
  12 my ($guards_count, $compat_handler, $foreign_handler);
  13
  14 sub new {
  15   my ($class, $storage) = @_;
  16
  17   $storage->txn_begin;
  18   my $guard = bless [ 0, $storage, $storage->_dbh ], ref $class || $class;
  19
  20
  21   # install a callback carefully
  22   if (DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT and !$guards_count) {
  23
  24     # if the thrown exception is a plain string, wrap it in our
  25     # own exception class
  26     # this is actually a pretty cool idea, may very well keep it
  27     # after perl is fixed
  28     $compat_handler ||= bless(
  29       sub {
  30         $@ = (blessed($_[0]) or ref($_[0]))
  31           ? $_[0]
  32           : bless ( { msg => $_[0] }, 'DBIx::Class::Exception')
  33         ;
  34         die;
  35       },
  36       '__TxnScopeGuard__FIXUP__',
  37     );
  38
  39     if ($foreign_handler = $SIG{__DIE__}) {
  40       $SIG{__DIE__} = bless (
  41         sub {
  42           # we trust the foreign handler to do whatever it wants, all we do is set $@
  43           eval { $compat_handler->(@_) };
  44           $foreign_handler->(@_);
  45         },
  46         '__TxnScopeGuard__FIXUP__',
  47       );
  48     }
  49     else {
  50       $SIG{__DIE__} = $compat_handler;
  51     }
  52   }
  53
  54   $guards_count++;
  55
  56   weaken ($guard->[2]);
  57   $guard;
  58 }
  59
  60 sub commit {
  61   my $self = shift;
  62
  63   $self->[1]->txn_commit;
  64   $self->[0] = 1;
  65 }
  66
  67 sub DESTROY {
  68   my ($dismiss, $storage) = @{$_[0]};
  69
  70   $guards_count--;
  71
  72   # don't touch unless it's ours, and there are no more of us left
  73   if (
  74     DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT
  75       and
  76     !$guards_count
  77   ) {
  78
  79     if (ref $SIG{__DIE__} eq '__TxnScopeGuard__FIXUP__') {
  80       # restore what we saved
  81       if ($foreign_handler) {
  82         $SIG{__DIE__} = $foreign_handler;
  83       }
  84       else {
  85         delete $SIG{__DIE__};
  86       }
  87     }
  88
  89     # make sure we do not leak the foreign one in case it exists
  90     undef $foreign_handler;
  91   }
  92
  93   return if $dismiss;
  94
  95   # if our dbh is not ours anymore, the weakref will go undef
  96   $storage->_verify_pid;
  97   return unless $_[0]->[2];
  98
  99   my $exception = $@;
 100
 101   {
 102     local $@;
 103
 104     carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
 105       unless $exception;
 106
 107     my $rollback_exception;
 108     # do minimal connectivity check due to weird shit like
 109     # https://rt.cpan.org/Public/Bug/Display.html?id=62370
 110     try { $storage->_seems_connected && $storage->txn_rollback }
 111     catch { $rollback_exception = shift };
 112
 113     if ( $rollback_exception and (
 114       ! defined blessed $rollback_exception
 115           or
 116       ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION')
 117     ) ) {
 118       # append our text - THIS IS A TEMPORARY FIXUP!
 119       # a real stackable exception object is in the works
 120       if (ref $exception eq 'DBIx::Class::Exception') {
 121         $exception->{msg} = "Transaction aborted: $exception->{msg} "
 122           ."Rollback failed: ${rollback_exception}";
 123       }
 124       elsif ($exception) {
 125         $exception = "Transaction aborted: ${exception} "
 126           ."Rollback failed: ${rollback_exception}";
 127       }
 128       else {
 129         carp (join ' ',
 130           "********************* ROLLBACK FAILED!!! ********************",
 131           "\nA rollback operation failed after the guard went out of scope.",
 132           'This is potentially a disastrous situation, check your data for',
 133           "consistency: $rollback_exception"
 134         );
 135       }
 136     }
 137   }
 138
 139   $@ = $exception unless DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT;
 140 }
 141
 142 1;
 143
 144 __END__
 145
 146 =head1 NAME
 147
 148 DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling
 149
 150 =head1 SYNOPSIS
 151
 152  sub foo {
 153    my ($self, $schema) = @_;
 154
 155    my $guard = $schema->txn_scope_guard;
 156
 157    # Multiple database operations here
 158
 159    $guard->commit;
 160  }
 161
 162 =head1 DESCRIPTION
 163
 164 An object that behaves much like L<Scope::Guard>, but hardcoded to do the
 165 right thing with transactions in DBIx::Class.
 166
 167 =head1 METHODS
 168
 169 =head2 new
 170
 171 Creating an instance of this class will start a new transaction (by
 172 implicitly calling L<DBIx::Class::Storage/txn_begin>. Expects a
 173 L<DBIx::Class::Storage> object as its only argument.
 174
 175 =head2 commit
 176
 177 Commit the transaction, and stop guarding the scope. If this method is not
 178 called and this object goes out of scope (e.g. an exception is thrown) then
 179 the transaction is rolled back, via L<DBIx::Class::Storage/txn_rollback>
 180
 181 =cut
 182
 183 =head1 SEE ALSO
 184
 185 L<DBIx::Class::Schema/txn_scope_guard>.
 186
 187 =head1 AUTHOR
 188
 189 Ash Berlin, 2008.
 190
 191 Inspired by L<Scope::Guard> by chocolateboy.
 192
 193 This module is free software. It may be used, redistributed and/or modified
 194 under the same terms as Perl itself.
 195
 196 =cut