X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage.pm;h=fc87ceb05c2dfa7d6ec2d61e6a1b6056b398b3b0;hb=0dd1b7362ff4b104d68946ae6ca8e7e483621381;hp=d72840fc50edd00fe9ffed84b2e6924a63372336;hpb=a807d01239319ad5be90dc7856657f819634a972;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm index d72840f..fc87ceb 100644 --- a/lib/DBIx/Class/Storage.pm +++ b/lib/DBIx/Class/Storage.pm @@ -13,6 +13,7 @@ use mro 'c3'; } use DBIx::Class::Carp; +use DBIx::Class::Storage::BlockRunner; use Scalar::Util qw/blessed weaken/; use DBIx::Class::Storage::TxnScopeGuard; use Try::Tiny; @@ -50,7 +51,6 @@ sub new { $self = ref $self if ref $self; my $new = bless( { - transaction_depth => 0, savepoints => [], }, $self); @@ -174,88 +174,16 @@ transaction failure. sub txn_do { my $self = shift; - my $coderef = shift; - ref $coderef eq 'CODE' or $self->throw_exception - ('$coderef must be a CODE reference'); - - my $abort_txn = sub { - my ($self, $exception) = @_; - - my $rollback_exception = try { $self->txn_rollback; undef } catch { shift }; - - if ( $rollback_exception and ( - ! defined blessed $rollback_exception - or - ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION') - ) ) { - $self->throw_exception( - "Transaction aborted: ${exception}. " - . "Rollback failed: ${rollback_exception}" - ); - } - $self->throw_exception($exception); - }; - - # take a ref instead of a copy, to preserve coderef @_ aliasing semantics - my $args = \@_; - - # do not turn on until a succesful txn_begin - my $attempt_commit = 0; - - my $txn_init_depth = $self->transaction_depth; - - try { - $self->txn_begin; - $attempt_commit = 1; - $coderef->(@$args) - } - catch { - $attempt_commit = 0; - - # init depth of > 0 implies nesting or non-autocommit (either way no retry) - if($txn_init_depth or $self->connected ) { - $abort_txn->($self, $_); - } - else { - carp "Retrying txn_do($coderef) after catching disconnected exception: $_" - if $ENV{DBIC_STORAGE_RETRY_DEBUG}; - - $self->_populate_dbh; - - # if txn_depth is > 1 this means something was done to the - # original $dbh, otherwise we would not get past the if() above - $self->throw_exception(sprintf - 'Unexpected transaction depth of %d on freshly connected handle', - $self->transaction_depth, - ) if $self->transaction_depth; - - $self->txn_begin; - $attempt_commit = 1; - - try { - $coderef->(@$args) - } - catch { - $attempt_commit = 0; - $abort_txn->($self, $_) - }; - }; - } - finally { - if ($attempt_commit) { - my $delta_txn = (1 + $txn_init_depth) - $self->transaction_depth; - - if ($delta_txn) { - # a rollback in a top-level txn_do is valid-ish (seen in the wild and our own tests) - carp "Unexpected reduction of transaction depth by $delta_txn after execution of $coderef, skipping txn_do's commit" - unless $delta_txn == 1 and $self->transaction_depth == 0; - } - else { - $self->txn_commit; - } - } - }; + DBIx::Class::Storage::BlockRunner->new( + storage => $self, + wrap_txn => 1, + retry_handler => sub { + $_[0]->failed_attempt_count == 1 + and + ! $_[0]->storage->connected + }, + )->run(@_); } =head2 txn_begin @@ -298,6 +226,7 @@ sub txn_commit { $self->debugobj->txn_commit() if $self->debug; $self->_exec_txn_commit; $self->{transaction_depth}--; + $self->savepoints([]); } elsif($self->transaction_depth > 1) { $self->{transaction_depth}--; @@ -321,8 +250,20 @@ sub txn_rollback { if ($self->transaction_depth == 1) { $self->debugobj->txn_rollback() if $self->debug; - $self->_exec_txn_rollback; $self->{transaction_depth}--; + + # in case things get really hairy - just disconnect + eval { $self->_exec_txn_rollback; 1 } or do { + my $rollback_error = $@; + + # whatever happens, too low down the stack to care + # FIXME - revisit if stackable exceptions become a thing + eval { $self->disconnect }; + + die $rollback_error; + }; + + $self->savepoints([]); } elsif ($self->transaction_depth > 1) { $self->{transaction_depth}--; @@ -342,6 +283,95 @@ sub txn_rollback { } } +# to be called by several internal stacked transaction handler codepaths +# not for external consumption +# *DOES NOT* throw exceptions, instead: +# - returns false on success +# - returns the exception on failed rollback +sub __delicate_rollback { + my $self = shift; + + if ( + ( $self->transaction_depth || 0 ) > 1 + and + # FIXME - the autosvp check here shouldn't be happening, it should be a role-ish thing + # The entire concept needs to be rethought with the storage layer... or something + ! $self->auto_savepoint + and + # the handle seems healthy, and there is nothing for us to do with it + # just go ahead and bow out, without triggering the txn_rollback() "nested exception" + # the unwind will eventually fail somewhere higher up if at all + # FIXME: a ::Storage::DBI-specific method, not a generic ::Storage one + $self->_seems_connected + ) { + # all above checks out - there is nothing to do on the $dbh itself + # just a plain soft-decrease of depth + $self->{transaction_depth}--; + return; + } + + my $rbe; + + local $@; # taking no chances + unless( eval { $self->txn_rollback; 1 } ) { + + $rbe = $@; + + # we were passed an existing exception to augment (think DESTROY stacks etc) + if (@_) { + my $exception = shift; + + # append our text - THIS IS A TEMPORARY FIXUP! + # + # If the passed in exception is a reference, or an object we don't know + # how to augment - flattening it is just damn rude + if ( + # FIXME - a better way, not liable to destroy an existing exception needs + # to be created. For the time being perpetuating the sin below in order + # to break the deadlock of which yak is being shaved first + 0 + and + length ref $$exception + and + ( + ! defined blessed $$exception + or + ! $$exception->isa( 'DBIx::Class::Exception' ) + ) + ) { + + ################## + ### FIXME - TODO + ################## + + } + else { + + # SUCH HIDEOUS, MUCH AUGH! (and double WOW on the s/// at the end below) + $rbe =~ s/ at .+? line \d+$//; + + ( + ( + defined blessed $$exception + and + $$exception->isa( 'DBIx::Class::Exception' ) + ) + ? ( + $$exception->{msg} = + "Transaction aborted: $$exception->{msg}. Rollback failed: $rbe" + ) + : ( + $$exception = + "Transaction aborted: $$exception. Rollback failed: $rbe" + ) + ) =~ s/Transaction aborted: (?=Transaction aborted:)//; + } + } + } + + return $rbe; +} + =head2 svp_begin Arguments: $savepoint_name? @@ -460,29 +490,25 @@ sub svp_rollback { $exec->($self, $name); } -=begin comment - - =head2 txn_scope_guard - - An alternative way of transaction handling based on - L: +=head2 txn_scope_guard - my $txn_guard = $storage->txn_scope_guard; +An alternative way of transaction handling based on +L: - $row->col1("val1"); - $row->update; + my $txn_guard = $storage->txn_scope_guard; - $txn_guard->commit; + $result->col1("val1"); + $result->update; - If an exception occurs, or the guard object otherwise leaves the scope - before C<< $txn_guard->commit >> is called, the transaction will be rolled - back by an explicit L call. In essence this is akin to - using a L/L pair, without having to worry - about calling L at the right places. Note that since there - is no defined code closure, there will be no retries and other magic upon - database disconnection. If you need such functionality see L. + $txn_guard->commit; -=end comment +If an exception occurs, or the guard object otherwise leaves the scope +before C<< $txn_guard->commit >> is called, the transaction will be rolled +back by an explicit L call. In essence this is akin to +using a L/L pair, without having to worry +about calling L at the right places. Note that since there +is no defined code closure, there will be no retries and other magic upon +database disconnection. If you need such functionality see L. =cut @@ -509,10 +535,10 @@ shell environment. =head2 debugfh -Set or retrieve the filehandle used for trace/debug output. This should be -an IO::Handle compatible object (only the C method is used. Initially -set to be STDERR - although see information on the -L environment variable. +An opportunistic proxy to L<< ->debugobj->debugfh(@_) +|DBIx::Class::Storage::Statistics/debugfh >> +If the currently set L does not have a L method, caling +this is a no-op. =cut @@ -543,8 +569,13 @@ sub debugobj { $self->{debugobj} ||= do { if (my $profile = $ENV{DBIC_TRACE_PROFILE}) { require DBIx::Class::Storage::Debug::PrettyPrint; + my @pp_args; + if ($profile =~ /^\.?\//) { - require Config::Any; + + if ( my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('config_file_reader') ) { + $self->throw_exception("Unable to parse TRACE_PROFILE config file '$profile' without $missing"); + } my $cfg = try { Config::Any->load_files({ files => [$profile], use_ext => 1 }); @@ -554,10 +585,28 @@ sub debugobj { $self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_"); }; - DBIx::Class::Storage::Debug::PrettyPrint->new(values %{$cfg->[0]}); + @pp_args = values %{$cfg->[0]}; } else { - DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile }); + @pp_args = { profile => $profile }; + } + + # FIXME - FRAGILE + # Hash::Merge is a sorry piece of shit and tramples all over $@ + # *without* throwing an exception + # This is a rather serious problem in the debug codepath + # Insulate the condition here with a try{} until a review of + # DBIx::Class::Storage::Debug::PrettyPrint takes place + # we do rethrow the error unconditionally, the only reason + # to try{} is to preserve the precise state of $@ (down + # to the scalar (if there is one) address level) + # + # Yes I am aware this is fragile and TxnScopeGuard needs + # a better fix. This is another yak to shave... :( + try { + DBIx::Class::Storage::Debug::PrettyPrint->new(@pp_args); + } catch { + $self->throw_exception($_); } } else { @@ -689,7 +738,6 @@ filename the file is read with L and the results are used as the configuration for tracing. See L for what that structure should look like. - =head2 DBIX_CLASS_STORAGE_DBI_DEBUG Old name for DBIC_TRACE @@ -699,15 +747,16 @@ Old name for DBIC_TRACE L - reference storage implementation using SQL::Abstract and DBI. -=head1 AUTHORS - -Matt S. Trout +=head1 FURTHER QUESTIONS? -Andy Grundman +Check the list of L. -=head1 LICENSE +=head1 COPYRIGHT AND LICENSE -You may distribute this code under the same terms as Perl itself. +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L. =cut