X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage.pm;h=47aef3699b7d636ed6e01f8b25570ad086c7bdea;hb=7b87b77c04e07cfea1103dba8ecbd3f219e949d2;hp=572f87ed2080a6050d8c7e9779c2f4116482e9f4;hpb=4d93345c2f06a03076dcb43cb256de5c973c203b;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm index 572f87e..47aef36 100644 --- a/lib/DBIx/Class/Storage.pm +++ b/lib/DBIx/Class/Storage.pm @@ -16,6 +16,7 @@ use DBIx::Class::Carp; use DBIx::Class::Storage::BlockRunner; use Scalar::Util qw/blessed weaken/; use DBIx::Class::Storage::TxnScopeGuard; +use DBIx::Class::_Util 'dbic_internal_try'; use Try::Tiny; use namespace::clean; @@ -51,7 +52,6 @@ sub new { $self = ref $self if ref $self; my $new = bless( { - transaction_depth => 0, savepoints => [], }, $self); @@ -251,8 +251,19 @@ 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 + dbic_internal_try { $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 + dbic_internal_try { $self->disconnect }; + + die $rollback_error; + }; + $self->savepoints([]); } elsif ($self->transaction_depth > 1) { @@ -273,6 +284,98 @@ 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 @args = @_; + my $rbe; + + dbic_internal_try { + $self->txn_rollback; 1 + } + catch { + + $rbe = $_; + + # we were passed an existing exception to augment (think DESTROY stacks etc) + if (@args) { + my ($exception) = @args; + + # 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? @@ -473,9 +576,12 @@ sub debugobj { my @pp_args; if ($profile =~ /^\.?\//) { - require Config::Any; - my $cfg = try { + 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 = dbic_internal_try { Config::Any->load_files({ files => [$profile], use_ext => 1 }); } catch { # sanitize the error message a bit @@ -501,7 +607,7 @@ sub debugobj { # # Yes I am aware this is fragile and TxnScopeGuard needs # a better fix. This is another yak to shave... :( - try { + dbic_internal_try { DBIx::Class::Storage::Debug::PrettyPrint->new(@pp_args); } catch { $self->throw_exception($_); @@ -636,7 +742,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 @@ -646,13 +751,16 @@ Old name for DBIC_TRACE L - reference storage implementation using SQL::Abstract and DBI. -=head1 AUTHOR AND CONTRIBUTORS +=head1 FURTHER QUESTIONS? -See L and L in DBIx::Class +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