FREW / DBIx-Class-0.08250_02 / lib / DBIx / Class / Storage / TxnScopeGuard.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
—
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167

              
package DBIx::Class::Storage::TxnScopeGuard;
use strict;
use warnings;
use Try::Tiny;
use Scalar::Util qw/weaken blessed refaddr/;
use DBIx::Class;
use DBIx::Class::Carp;
use namespace::clean;
sub new {
  my ($class, $storage) = @_;
  my $guard = {
    inactivated => 0,
    storage => $storage,
  };
  # we are starting with an already set $@ - in order for things to work we need to
  # be able to recognize it upon destruction - store its weakref
  # recording it before doing the txn_begin stuff
  #
  # FIXME FRAGILE - any eval that fails but *does not* rethrow between here
  # and the unwind will trample over $@ and invalidate the entire mechanism
  # There got to be a saner way of doing this...
  if (defined $@ and $@ ne '') {
    weaken(
      $guard->{existing_exception_ref} = (ref $@ ne '') ? $@ : \$@
    );
  }
  $storage->txn_begin;
  weaken( $guard->{dbh} = $storage->_dbh );
  bless $guard, ref $class || $class;
  $guard;
}
sub commit {
  my $self = shift;
  $self->{storage}->throw_exception("Refusing to execute multiple commits on scope guard $self")
    if $self->{inactivated};
  $self->{storage}->txn_commit;
  $self->{inactivated} = 1;
}
sub DESTROY {
  my $self = shift;
  return if $self->{inactivated};
  # if our dbh is not ours anymore, the $dbh weakref will go undef
  $self->{storage}->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
  return unless $self->{dbh};
  my $exception = $@ if (
    defined $@
      and
    $@ ne ''
      and
    (
      ! defined $self->{existing_exception_ref}
        or
      refaddr( ref $@ eq '' ? \$@ : $@ ) != refaddr($self->{existing_exception_ref})
    )
  );
  {
    local $@;
    carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
      unless defined $exception;
    my $rollback_exception;
    # do minimal connectivity check due to weird shit like
    # https://rt.cpan.org/Public/Bug/Display.html?id=62370
    try { $self->{storage}->_seems_connected && $self->{storage}->txn_rollback }
    catch { $rollback_exception = shift };
    if ( $rollback_exception and (
      ! defined blessed $rollback_exception
          or
      ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION')
    ) ) {
      # append our text - THIS IS A TEMPORARY FIXUP!
      # a real stackable exception object is in the works
      if (ref $exception eq 'DBIx::Class::Exception') {
        $exception->{msg} = "Transaction aborted: $exception->{msg} "
          ."Rollback failed: ${rollback_exception}";
      }
      elsif ($exception) {
        $exception = "Transaction aborted: ${exception} "
          ."Rollback failed: ${rollback_exception}";
      }
      else {
        carp (join ' ',
          "********************* ROLLBACK FAILED!!! ********************",
          "\nA rollback operation failed after the guard went out of scope.",
          'This is potentially a disastrous situation, check your data for',
          "consistency: $rollback_exception"
        );
      }
    }
  }
  $@ = $exception;
}
1;
__END__
=head1 NAME
DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling
=head1 SYNOPSIS
 sub foo {
   my ($self, $schema) = @_;
   my $guard = $schema->txn_scope_guard;
   # Multiple database operations here
   $guard->commit;
 }
=head1 DESCRIPTION
An object that behaves much like L<Scope::Guard>, but hardcoded to do the
right thing with transactions in DBIx::Class.
=head1 METHODS
=head2 new
Creating an instance of this class will start a new transaction (by
implicitly calling L<DBIx::Class::Storage/txn_begin>. Expects a
L<DBIx::Class::Storage> object as its only argument.
=head2 commit
Commit the transaction, and stop guarding the scope. If this method is not
called and this object goes out of scope (e.g. an exception is thrown) then
the transaction is rolled back, via L<DBIx::Class::Storage/txn_rollback>
=cut
=head1 SEE ALSO
L<DBIx::Class::Schema/txn_scope_guard>.
=head1 AUTHOR
Ash Berlin, 2008.
Inspired by L<Scope::Guard> by chocolateboy.
This module is free software. It may be used, redistributed and/or modified
under the same terms as Perl itself.
=cut