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/);
__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
$self = ref $self if ref $self;
my $new = bless( {
- transaction_depth => 0,
savepoints => [],
}, $self);
my $rs;
try {
$rs = $schema->txn_do($coderef);
- } catch {
+ } dbic_internal_catch {
my $error = shift;
# Transaction failed
die "something terrible has happened!"
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
$self->debugobj->txn_commit() if $self->debug;
$self->_exec_txn_commit;
$self->{transaction_depth}--;
+ $self->savepoints([]);
}
elsif($self->transaction_depth > 1) {
$self->{transaction_depth}--;
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}--;
}
}
+# 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?
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
}
my $txn_guard = $storage->txn_scope_guard;
- $row->col1("val1");
- $row->update;
+ $result->col1("val1");
+ $result->update;
$txn_guard->commit;
=head2 debugfh
-Set or retrieve the filehandle used for trace/debug output. This should be
-an IO::Handle compatible object (only the C<print> method is used. Initially
-set to be STDERR - although see information on the
-L<DBIC_TRACE> environment variable.
+An opportunistic proxy to L<< ->debugobj->debugfh(@_)
+|DBIx::Class::Storage::Statistics/debugfh >>
+If the currently set L</debugobj> does not have a L</debugfh> method, caling
+this is a no-op.
=cut
$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 {
used as the configuration for tracing. See L<SQL::Abstract::Tree/new>
for what that structure should look like.
-
=head2 DBIX_CLASS_STORAGE_DBI_DEBUG
Old name for DBIC_TRACE
L<DBIx::Class::Storage::DBI> - reference storage implementation using
SQL::Abstract and DBI.
-=head1 AUTHOR AND CONTRIBUTORS
+=head1 FURTHER QUESTIONS?
-See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
-You may distribute this code under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
=cut
projects / dbsrgits/DBIx-Class.git / blobdiff