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