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::Carp;
   9 use namespace::clean;
  10
  11 sub new {
  12   my ($class, $storage) = @_;
  13
  14   my $guard = {
  15     inactivated => 0,
  16     storage => $storage,
  17   };
  18
  19   # we are starting with an already set $@ - in order for things to work we need to
  20   # be able to recognize it upon destruction - store its weakref
  21   # recording it before doing the txn_begin stuff
  22   #
  23   # FIXME FRAGILE - any eval that fails but *does not* rethrow between here
  24   # and the unwind will trample over $@ and invalidate the entire mechanism
  25   # There got to be a saner way of doing this...
  26   if (defined $@ and $@ ne '') {
  27     weaken(
  28       $guard->{existing_exception_ref} = (ref $@ ne '') ? $@ : \$@
  29     );
  30   }
  31
  32   $storage->txn_begin;
  33
  34   weaken( $guard->{dbh} = $storage->_dbh );
  35
  36   bless $guard, ref $class || $class;
  37
  38   $guard;
  39 }
  40
  41 sub commit {
  42   my $self = shift;
  43
  44   $self->{storage}->throw_exception("Refusing to execute multiple commits on scope guard $self")
  45     if $self->{inactivated};
  46
  47   $self->{storage}->txn_commit;
  48   $self->{inactivated} = 1;
  49 }
  50
  51 sub DESTROY {
  52   my $self = shift;
  53
  54   return if $self->{inactivated};
  55
  56   # if our dbh is not ours anymore, the $dbh weakref will go undef
  57   $self->{storage}->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
  58   return unless $self->{dbh};
  59
  60   my $exception = $@ if (
  61     defined $@
  62       and
  63     $@ ne ''
  64       and
  65     (
  66       ! defined $self->{existing_exception_ref}
  67         or
  68       refaddr( ref $@ eq '' ? \$@ : $@ ) != refaddr($self->{existing_exception_ref})
  69     )
  70   );
  71
  72   {
  73     local $@;
  74
  75     carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
  76       unless defined $exception;
  77
  78     my $rollback_exception;
  79     # do minimal connectivity check due to weird shit like
  80     # https://rt.cpan.org/Public/Bug/Display.html?id=62370
  81     try { $self->{storage}->_seems_connected && $self->{storage}->txn_rollback }
  82     catch { $rollback_exception = shift };
  83
  84     if ( $rollback_exception and (
  85       ! defined blessed $rollback_exception
  86           or
  87       ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION')
  88     ) ) {
  89       # append our text - THIS IS A TEMPORARY FIXUP!
  90       # a real stackable exception object is in the works
  91       if (ref $exception eq 'DBIx::Class::Exception') {
  92         $exception->{msg} = "Transaction aborted: $exception->{msg} "
  93           ."Rollback failed: ${rollback_exception}";
  94       }
  95       elsif ($exception) {
  96         $exception = "Transaction aborted: ${exception} "
  97           ."Rollback failed: ${rollback_exception}";
  98       }
  99       else {
 100         carp (join ' ',
 101           "********************* ROLLBACK FAILED!!! ********************",
 102           "\nA rollback operation failed after the guard went out of scope.",
 103           'This is potentially a disastrous situation, check your data for',
 104           "consistency: $rollback_exception"
 105         );
 106       }
 107     }
 108   }
 109
 110   $@ = $exception;
 111 }
 112
 113 1;
 114
 115 __END__
 116
 117 =head1 NAME
 118
 119 DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling
 120
 121 =head1 SYNOPSIS
 122
 123  sub foo {
 124    my ($self, $schema) = @_;
 125
 126    my $guard = $schema->txn_scope_guard;
 127
 128    # Multiple database operations here
 129
 130    $guard->commit;
 131  }
 132
 133 =head1 DESCRIPTION
 134
 135 An object that behaves much like L<Scope::Guard>, but hardcoded to do the
 136 right thing with transactions in DBIx::Class.
 137
 138 =head1 METHODS
 139
 140 =head2 new
 141
 142 Creating an instance of this class will start a new transaction (by
 143 implicitly calling L<DBIx::Class::Storage/txn_begin>. Expects a
 144 L<DBIx::Class::Storage> object as its only argument.
 145
 146 =head2 commit
 147
 148 Commit the transaction, and stop guarding the scope. If this method is not
 149 called and this object goes out of scope (e.g. an exception is thrown) then
 150 the transaction is rolled back, via L<DBIx::Class::Storage/txn_rollback>
 151
 152 =cut
 153
 154 =head1 SEE ALSO
 155
 156 L<DBIx::Class::Schema/txn_scope_guard>.
 157
 158 =head1 AUTHOR
 159
 160 Ash Berlin, 2008.
 161
 162 Inspired by L<Scope::Guard> by chocolateboy.
 163
 164 This module is free software. It may be used, redistributed and/or modified
 165 under the same terms as Perl itself.
 166
 167 =cut