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