}
use DBIx::Class::Carp;
+use DBIx::Class::Storage::BlockRunner;
use Scalar::Util qw/blessed weaken/;
use DBIx::Class::Storage::TxnScopeGuard;
use Try::Tiny;
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,
+ 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;
}
=head2 txn_begin
$exec->($self, $name);
}
-=begin comment
-
- =head2 txn_scope_guard
+=head2 txn_scope_guard
- An alternative way of transaction handling based on
- L<DBIx::Class::Storage::TxnScopeGuard>:
+An alternative way of transaction handling based on
+L<DBIx::Class::Storage::TxnScopeGuard>:
- my $txn_guard = $storage->txn_scope_guard;
+ my $txn_guard = $storage->txn_scope_guard;
- $row->col1("val1");
- $row->update;
+ $row->col1("val1");
+ $row->update;
- $txn_guard->commit;
+ $txn_guard->commit;
- 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</txn_rollback> call. In essence this is akin to
- using a L</txn_begin>/L</txn_commit> pair, without having to worry
- about calling L</txn_rollback> 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_do>.
-
-=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</txn_rollback> call. In essence this is akin to
+using a L</txn_begin>/L</txn_commit> pair, without having to worry
+about calling L</txn_rollback> 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_do>.
=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;
$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 {
L<DBIx::Class::Storage::DBI> - reference storage implementation using
SQL::Abstract and DBI.
-=head1 AUTHORS
-
-Matt S. Trout <mst@shadowcatsystems.co.uk>
+=head1 AUTHOR AND CONTRIBUTORS
-Andy Grundman <andy@hybridized.org>
+See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
=head1 LICENSE