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