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/;
   8 use namespace::clean;
   9
  10 sub new {
  11   my ($class, $storage) = @_;
  12
  13   $storage->txn_begin;
  14   my $guard = bless [ 0, $storage, $storage->_dbh ], ref $class || $class;
  15   weaken ($guard->[2]);
  16   $guard;
  17 }
  18
  19 sub commit {
  20   my $self = shift;
  21
  22   $self->[1]->txn_commit;
  23   $self->[0] = 1;
  24 }
  25
  26 sub DESTROY {
  27   my ($dismiss, $storage) = @{$_[0]};
  28
  29   return if $dismiss;
  30
  31   # if our dbh is not ours anymore, the weakref will go undef
  32   $storage->_preserve_foreign_dbh;
  33   return unless $_[0]->[2];
  34
  35   my $exception = $@;
  36
  37   {
  38     local $@;
  39
  40     carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
  41       unless $exception;
  42
  43     my $rollback_exception;
  44     # do minimal connectivity check due to weird shit like
  45     # https://rt.cpan.org/Public/Bug/Display.html?id=62370
  46     try { $storage->_seems_connected && $storage->txn_rollback }
  47     catch { $rollback_exception = shift };
  48
  49     if (defined $rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) {
  50       if ($exception) {
  51         $exception = "Transaction aborted: ${exception} "
  52           ."Rollback failed: ${rollback_exception}";
  53       }
  54       else {
  55         carp (join ' ',
  56           "********************* ROLLBACK FAILED!!! ********************",
  57           "\nA rollback operation failed after the guard went out of scope.",
  58           'This is potentially a disastrous situation, check your data for',
  59           "consistency: $rollback_exception"
  60         );
  61       }
  62     }
  63   }
  64
  65   $@ = $exception;
  66 }
  67
  68 1;
  69
  70 __END__
  71
  72 =head1 NAME
  73
  74 DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling
  75
  76 =head1 SYNOPSIS
  77
  78  sub foo {
  79    my ($self, $schema) = @_;
  80
  81    my $guard = $schema->txn_scope_guard;
  82
  83    # Multiple database operations here
  84
  85    $guard->commit;
  86  }
  87
  88 =head1 DESCRIPTION
  89
  90 An object that behaves much like L<Scope::Guard>, but hardcoded to do the
  91 right thing with transactions in DBIx::Class.
  92
  93 =head1 METHODS
  94
  95 =head2 new
  96
  97 Creating an instance of this class will start a new transaction (by
  98 implicitly calling L<DBIx::Class::Storage/txn_begin>. Expects a
  99 L<DBIx::Class::Storage> object as its only argument.
 100
 101 =head2 commit
 102
 103 Commit the transaction, and stop guarding the scope. If this method is not
 104 called and this object goes out of scope (e.g. an exception is thrown) then
 105 the transaction is rolled back, via L<DBIx::Class::Storage/txn_rollback>
 106
 107 =cut
 108
 109 =head1 SEE ALSO
 110
 111 L<DBIx::Class::Schema/txn_scope_guard>.
 112
 113 =head1 AUTHOR
 114
 115 Ash Berlin, 2008.
 116
 117 Inspired by L<Scope::Guard> by chocolateboy.
 118
 119 This module is free software. It may be used, redistributed and/or modified
 120 under the same terms as Perl itself.
 121
 122 =cut