X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage.pm;h=dfff9a1a499e4776c328aa318da4bd9471794b01;hb=dc7d89911b7bb98c30208cf73af522a99998dcd6;hp=6b88d2847c9df446546a65fa7b3722931f70b5ac;hpb=6864429af43e4ab081343157784d5e00dca7200d;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm index 6b88d28..dfff9a1 100644 --- a/lib/DBIx/Class/Storage.pm +++ b/lib/DBIx/Class/Storage.pm @@ -6,17 +6,17 @@ use warnings; use base qw/DBIx::Class/; use mro 'c3'; -{ - package # Hide from PAUSE - DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION; - use base 'DBIx::Class::Exception'; +BEGIN { + no warnings 'once'; + @DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION::ISA + = 'DBIx::Class::Exception'; } use DBIx::Class::Carp; use DBIx::Class::Storage::BlockRunner; use Scalar::Util qw/blessed weaken/; use DBIx::Class::Storage::TxnScopeGuard; -use Try::Tiny; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch fail_on_internal_call ); use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/debug schema transaction_depth auto_savepoint savepoints/); @@ -24,7 +24,10 @@ __PACKAGE__->mk_group_accessors(component_class => 'cursor_class'); __PACKAGE__->cursor_class('DBIx::Class::Cursor'); -sub cursor { shift->cursor_class(@_); } +sub cursor :DBIC_method_is_indirect_sugar { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + shift->cursor_class(@_); +} =head1 NAME @@ -51,7 +54,6 @@ sub new { $self = ref $self if ref $self; my $new = bless( { - transaction_depth => 0, savepoints => [], }, $self); @@ -149,7 +151,7 @@ For example, my $rs; try { $rs = $schema->txn_do($coderef); - } catch { + } dbic_internal_catch { my $error = shift; # Transaction failed die "something terrible has happened!" @@ -175,18 +177,16 @@ transaction failure. sub txn_do { my $self = shift; - my $coderef = shift; DBIx::Class::Storage::BlockRunner->new( storage => $self, - run_code => $coderef, - run_args => @_ - ? \@_ # take a ref instead of a copy, to preserve @_ aliasing - : [] # semantics within the coderef, but only if needed - , # (pseudoforking doesn't like this trick much) wrap_txn => 1, - retry_handler => sub { ! ( $_[0]->retried_count or $_[0]->storage->connected ) }, - )->run; + retry_handler => sub { + $_[0]->failed_attempt_count == 1 + and + ! $_[0]->storage->connected + }, + )->run(@_); } =head2 txn_begin @@ -229,6 +229,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}--; @@ -252,8 +253,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 + 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) { $self->{transaction_depth}--; @@ -273,6 +286,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 + } + dbic_internal_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? @@ -328,12 +433,15 @@ sub svp_release { if (defined $name) { my @stack = @{ $self->savepoints }; - my $svp; + my $svp = ''; - do { $svp = pop @stack } until $svp eq $name; + while( $svp ne $name ) { - $self->throw_exception ("Savepoint '$name' does not exist") - unless $svp; + $self->throw_exception ("Savepoint '$name' does not exist") + unless @stack; + + $svp = pop @stack; + } $self->savepoints(\@stack); # put back what's left } @@ -398,8 +506,8 @@ L: my $txn_guard = $storage->txn_scope_guard; - $row->col1("val1"); - $row->update; + $result->col1("val1"); + $result->update; $txn_guard->commit; @@ -436,10 +544,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 @@ -470,21 +578,45 @@ 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; - my $cfg = try { + require DBIx::Class::Optional::Dependencies; + 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 { + } dbic_internal_catch { # sanitize the error message a bit $_ =~ s/at \s+ .+ Storage\.pm \s line \s \d+ $//x; $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... :( + dbic_internal_try { + DBIx::Class::Storage::Debug::PrettyPrint->new(@pp_args); + } dbic_internal_catch { + $self->throw_exception($_); } } else { @@ -616,7 +748,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 @@ -626,13 +757,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