| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package DBIx::Class::Storage::TxnScopeGuard; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 271 |  |  | 271 |  | 2874 | use strict; | 
|  | 271 |  |  |  |  | 986 |  | 
|  | 271 |  |  |  |  | 9076 |  | 
| 4 | 271 |  |  | 271 |  | 1623 | use warnings; | 
|  | 271 |  |  |  |  | 901 |  | 
|  | 271 |  |  |  |  | 7736 |  | 
| 5 | 271 |  |  | 271 |  | 1625 | use Try::Tiny; | 
|  | 271 |  |  |  |  | 994 |  | 
|  | 271 |  |  |  |  | 16857 |  | 
| 6 | 271 |  |  | 271 |  | 1982 | use Scalar::Util qw(weaken blessed refaddr); | 
|  | 271 |  |  |  |  | 1144 |  | 
|  | 271 |  |  |  |  | 14327 |  | 
| 7 | 271 |  |  | 271 |  | 2050 | use DBIx::Class; | 
|  | 271 |  |  |  |  | 909 |  | 
|  | 271 |  |  |  |  | 13190 |  | 
| 8 | 271 |  |  | 271 |  | 1957 | use DBIx::Class::_Util qw(is_exception detected_reinvoked_destructor); | 
|  | 271 |  |  |  |  | 1071 |  | 
|  | 271 |  |  |  |  | 15881 |  | 
| 9 | 271 |  |  | 271 |  | 2120 | use DBIx::Class::Carp; | 
|  | 271 |  |  |  |  | 926 |  | 
|  | 271 |  |  |  |  | 2463 |  | 
| 10 | 271 |  |  | 271 |  | 2161 | use namespace::clean; | 
|  | 271 |  |  |  |  | 1119 |  | 
|  | 271 |  |  |  |  | 2226 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | sub new { | 
| 13 | 9007 |  |  | 9007 | 1 | 20667 | my ($class, $storage) = @_; | 
| 14 |  |  |  |  |  |  |  | 
| 15 | 9007 |  |  |  |  | 28925 | 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 | 9007 | 100 |  |  |  | 31065 | if (is_exception $@) { | 
| 28 |  |  |  |  |  |  | weaken( | 
| 29 | 592 | 100 |  |  |  | 2982 | $guard->{existing_exception_ref} = (ref($@) eq '') ? \$@ : $@ | 
| 30 |  |  |  |  |  |  | ); | 
| 31 |  |  |  |  |  |  | } | 
| 32 |  |  |  |  |  |  |  | 
| 33 | 9007 |  |  |  |  | 220168 | $storage->txn_begin; | 
| 34 |  |  |  |  |  |  |  | 
| 35 | 9007 |  |  |  |  | 43711 | weaken( $guard->{dbh} = $storage->_dbh ); | 
| 36 |  |  |  |  |  |  |  | 
| 37 | 9007 |  | 33 |  |  | 37214 | bless $guard, ref $class || $class; | 
| 38 |  |  |  |  |  |  |  | 
| 39 | 9007 |  |  |  |  | 28540 | $guard; | 
| 40 |  |  |  |  |  |  | } | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | sub commit { | 
| 43 | 8874 |  |  | 8874 | 1 | 17344 | my $self = shift; | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | $self->{storage}->throw_exception("Refusing to execute multiple commits on scope guard $self") | 
| 46 | 8874 | 50 |  |  |  | 23096 | if $self->{inactivated}; | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | # FIXME - this assumption may be premature: a commit may fail and a rollback | 
| 49 |  |  |  |  |  |  | # *still* be necessary. Currently I am not aware of such scenarious, but I | 
| 50 |  |  |  |  |  |  | # also know the deferred constraint handling is *severely* undertested. | 
| 51 |  |  |  |  |  |  | # Making the change of "fire txn and never come back to this" in order to | 
| 52 |  |  |  |  |  |  | # address RT#107159, but this *MUST* be reevaluated later. | 
| 53 | 8874 |  |  |  |  | 16103 | $self->{inactivated} = 1; | 
| 54 | 8874 |  |  |  |  | 28414 | $self->{storage}->txn_commit; | 
| 55 |  |  |  |  |  |  | } | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | sub DESTROY { | 
| 58 | 9008 | 100 |  | 9008 |  | 31380 | return if &detected_reinvoked_destructor; | 
| 59 |  |  |  |  |  |  |  | 
| 60 | 9007 |  |  |  |  | 18739 | my $self = shift; | 
| 61 |  |  |  |  |  |  |  | 
| 62 | 9007 | 100 |  |  |  | 144203 | return if $self->{inactivated}; | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | # if our dbh is not ours anymore, the $dbh weakref will go undef | 
| 65 | 133 |  |  |  |  | 891 | $self->{storage}->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK; | 
| 66 | 133 | 100 |  |  |  | 1098 | return unless $self->{dbh}; | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | my $exception = $@ if ( | 
| 69 |  |  |  |  |  |  | is_exception $@ | 
| 70 |  |  |  |  |  |  | and | 
| 71 |  |  |  |  |  |  | ( | 
| 72 |  |  |  |  |  |  | ! defined $self->{existing_exception_ref} | 
| 73 |  |  |  |  |  |  | or | 
| 74 |  |  |  |  |  |  | refaddr( ref($@) eq '' ? \$@ : $@ ) != refaddr($self->{existing_exception_ref}) | 
| 75 | 123 | 50 | 33 |  |  | 500 | ) | 
|  |  |  | 66 |  |  |  |  | 
| 76 |  |  |  |  |  |  | ); | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | { | 
| 79 | 123 |  |  |  |  | 286 | local $@; | 
|  | 123 |  |  |  |  | 272 |  | 
| 80 |  |  |  |  |  |  |  | 
| 81 | 123 | 100 |  |  |  | 427 | carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.' | 
| 82 |  |  |  |  |  |  | unless defined $exception; | 
| 83 |  |  |  |  |  |  |  | 
| 84 | 123 |  |  |  |  | 538 | my $rollback_exception; | 
| 85 |  |  |  |  |  |  | # do minimal connectivity check due to weird shit like | 
| 86 |  |  |  |  |  |  | # https://rt.cpan.org/Public/Bug/Display.html?id=62370 | 
| 87 | 123 | 100 |  | 123 |  | 9970 | try { $self->{storage}->_seems_connected && $self->{storage}->txn_rollback } | 
| 88 | 123 |  |  | 6 |  | 1703 | catch { $rollback_exception = shift }; | 
|  | 6 |  |  |  |  | 201 |  | 
| 89 |  |  |  |  |  |  |  | 
| 90 | 123 | 100 | 66 |  |  | 2587 | if ( $rollback_exception and ( | 
|  |  |  | 100 |  |  |  |  | 
| 91 |  |  |  |  |  |  | ! defined blessed $rollback_exception | 
| 92 |  |  |  |  |  |  | or | 
| 93 |  |  |  |  |  |  | ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION') | 
| 94 |  |  |  |  |  |  | ) ) { | 
| 95 |  |  |  |  |  |  | # append our text - THIS IS A TEMPORARY FIXUP! | 
| 96 |  |  |  |  |  |  | # a real stackable exception object is in the works | 
| 97 | 5 | 50 |  |  |  | 28 | if (ref $exception eq 'DBIx::Class::Exception') { | 
|  |  | 100 |  |  |  |  |  | 
| 98 | 0 |  |  |  |  | 0 | $exception->{msg} = "Transaction aborted: $exception->{msg} " | 
| 99 |  |  |  |  |  |  | ."Rollback failed: ${rollback_exception}"; | 
| 100 |  |  |  |  |  |  | } | 
| 101 |  |  |  |  |  |  | elsif ($exception) { | 
| 102 | 3 |  |  |  |  | 19 | $exception = "Transaction aborted: ${exception} " | 
| 103 |  |  |  |  |  |  | ."Rollback failed: ${rollback_exception}"; | 
| 104 |  |  |  |  |  |  | } | 
| 105 |  |  |  |  |  |  | else { | 
| 106 | 2 |  |  |  |  | 15 | carp (join ' ', | 
| 107 |  |  |  |  |  |  | "********************* ROLLBACK FAILED!!! ********************", | 
| 108 |  |  |  |  |  |  | "\nA rollback operation failed after the guard went out of scope.", | 
| 109 |  |  |  |  |  |  | 'This is potentially a disastrous situation, check your data for', | 
| 110 |  |  |  |  |  |  | "consistency: $rollback_exception" | 
| 111 |  |  |  |  |  |  | ); | 
| 112 |  |  |  |  |  |  | } | 
| 113 |  |  |  |  |  |  | } | 
| 114 |  |  |  |  |  |  | } | 
| 115 |  |  |  |  |  |  |  | 
| 116 | 123 |  |  |  |  | 1125 | $@ = $exception; | 
| 117 |  |  |  |  |  |  | } | 
| 118 |  |  |  |  |  |  |  | 
| 119 |  |  |  |  |  |  | 1; | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | __END__ | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | =head1 NAME | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | sub foo { | 
| 130 |  |  |  |  |  |  | my ($self, $schema) = @_; | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | my $guard = $schema->txn_scope_guard; | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | # Multiple database operations here | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | $guard->commit; | 
| 137 |  |  |  |  |  |  | } | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | An object that behaves much like L<Scope::Guard>, but hardcoded to do the | 
| 142 |  |  |  |  |  |  | right thing with transactions in DBIx::Class. | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | =head1 METHODS | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | =head2 new | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | Creating an instance of this class will start a new transaction (by | 
| 149 |  |  |  |  |  |  | implicitly calling L<DBIx::Class::Storage/txn_begin>. Expects a | 
| 150 |  |  |  |  |  |  | L<DBIx::Class::Storage> object as its only argument. | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | =head2 commit | 
| 153 |  |  |  |  |  |  |  | 
| 154 |  |  |  |  |  |  | Commit the transaction, and stop guarding the scope. If this method is not | 
| 155 |  |  |  |  |  |  | called and this object goes out of scope (e.g. an exception is thrown) then | 
| 156 |  |  |  |  |  |  | the transaction is rolled back, via L<DBIx::Class::Storage/txn_rollback> | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | =cut | 
| 159 |  |  |  |  |  |  |  | 
| 160 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 161 |  |  |  |  |  |  |  | 
| 162 |  |  |  |  |  |  | L<DBIx::Class::Schema/txn_scope_guard>. | 
| 163 |  |  |  |  |  |  |  | 
| 164 |  |  |  |  |  |  | L<Scope::Guard> by chocolateboy (inspiration for this module) | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | =head1 FURTHER QUESTIONS? | 
| 167 |  |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>. | 
| 169 |  |  |  |  |  |  |  | 
| 170 |  |  |  |  |  |  | =head1 COPYRIGHT AND LICENSE | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE> | 
| 173 |  |  |  |  |  |  | by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can | 
| 174 |  |  |  |  |  |  | redistribute it and/or modify it under the same terms as the | 
| 175 |  |  |  |  |  |  | L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>. |