lib/DBIx/Class/Storage/TxnScopeGuard.pm

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