package # hide from pause until we figure it all out
DBIx::Class::Storage::BlockRunner;
-use Sub::Quote 'quote_sub';
+use strict;
+
use DBIx::Class::Exception;
use DBIx::Class::Carp;
use Context::Preserve 'preserve_context';
-use Scalar::Util qw/weaken blessed/;
+use DBIx::Class::_Util 'is_exception';
+use Scalar::Util qw(weaken blessed reftype);
use Try::Tiny;
-use Moo;
+
+# DO NOT edit away without talking to riba first, he will just put it back
+BEGIN {
+ local $ENV{PERL_STRICTURES_EXTRA} = 0;
+ require Moo; Moo->import;
+ require Sub::Quote; Sub::Quote->import('quote_sub');
+}
+use warnings NONFATAL => 'all';
use namespace::clean;
=head1 NAME
has retry_handler => (
is => 'ro',
required => 1,
- isa => quote_sub( q|
- (ref $_[0]) eq 'CODE'
+ isa => quote_sub( q{
+ (Scalar::Util::reftype($_[0])||'') eq 'CODE'
or DBIx::Class::Exception->throw('retry_handler must be a CODE reference')
- |),
-);
-
-has run_code => (
- is => 'ro',
- required => 1,
- isa => quote_sub( q|
- (ref $_[0]) eq 'CODE'
- or DBIx::Class::Exception->throw('run_code must be a CODE reference')
- |),
-);
-
-has run_args => (
- is => 'ro',
- isa => quote_sub( q|
- (ref $_[0]) eq 'ARRAY'
- or DBIx::Class::Exception->throw('run_args must be an ARRAY reference')
- |),
- default => quote_sub( '[]' ),
+ }),
);
has retry_debug => (
is => 'rw',
+ # use a sub - to be evaluated on the spot lazily
default => quote_sub( '$ENV{DBIC_STORAGE_RETRY_DEBUG}' ),
+ lazy => 1,
);
-has max_retried_count => (
+has max_attempts => (
is => 'ro',
- default => quote_sub( '20' ),
+ default => 20,
);
-has retried_count => (
+has failed_attempt_count => (
is => 'ro',
- init_arg => undef,
- writer => '_set_retried_count',
- clearer => '_reset_retried_count',
- default => quote_sub(q{ 0 }),
+ init_arg => undef, # ensures one can't pass the value in
+ writer => '_set_failed_attempt_count',
+ default => 0,
lazy => 1,
trigger => quote_sub(q{
- DBIx::Class::Exception->throw(sprintf (
- 'Exceeded max_retried_count amount of %d, latest exception: %s',
- $_[0]->max_retried_count, $_[0]->last_exception
- )) if $_[0]->max_retried_count < ($_[1]||0);
+ $_[0]->throw_exception( sprintf (
+ 'Reached max_attempts amount of %d, latest exception: %s',
+ $_[0]->max_attempts, $_[0]->last_exception
+ )) if $_[0]->max_attempts <= ($_[1]||0);
}),
);
sub last_exception { shift->exception_stack->[-1] }
+sub throw_exception { shift->storage->throw_exception (@_) }
+
sub run {
my $self = shift;
- DBIx::Class::Exception->throw('run() takes no arguments') if @_;
-
$self->_reset_exception_stack;
- $self->_reset_retried_count;
+ $self->_set_failed_attempt_count(0);
+
+ my $cref = shift;
+
+ $self->throw_exception('run() requires a coderef to execute as its first argument')
+ if ( reftype($cref)||'' ) ne 'CODE';
+
my $storage = $self->storage;
- return $self->run_code->( @{$self->run_args} )
- if (! $self->wrap_txn and $storage->{_in_do_block});
+ return $cref->( @_ ) if (
+ $storage->{_in_do_block}
+ and
+ ! $self->wrap_txn
+ );
local $storage->{_in_do_block} = 1 unless $storage->{_in_do_block};
- return $self->_run;
+ return $self->_run($cref, @_);
}
# this is the actual recursing worker
sub _run {
- # warnings here mean I did not anticipate some ueber-complex case
- # fatal warnings are not warranted
- no warnings;
- use warnings;
+ # internal method - we know that both refs are strong-held by the
+ # calling scope of run(), hence safe to weaken everything
+ weaken( my $self = shift );
+ weaken( my $cref = shift );
- my $self = shift;
+ my $args = @_ ? \@_ : [];
# from this point on (defined $txn_init_depth) is an indicator for wrap_txn
# save a bit on method calls
my $run_err = '';
- weaken (my $weakself = $self);
-
return preserve_context {
try {
if (defined $txn_init_depth) {
- $weakself->storage->txn_begin;
+ $self->storage->txn_begin;
$txn_begin_ok = 1;
}
- $weakself->run_code->( @{$weakself->run_args} );
+ $cref->( @$args );
} catch {
$run_err = $_;
(); # important, affects @_ below
} replace => sub {
my @res = @_;
- my $storage = $weakself->storage;
+ my $storage = $self->storage;
my $cur_depth = $storage->transaction_depth;
if (defined $txn_init_depth and $run_err eq '') {
'Unexpected reduction of transaction depth by %d after execution of '
. '%s, skipping txn_commit()',
$delta_txn,
- $weakself->run_code,
+ $cref,
) unless $delta_txn == 1 and $cur_depth == 0;
}
else {
}
# something above threw an error (could be the begin, the code or the commit)
- if ($run_err ne '') {
+ if ( is_exception $run_err ) {
# attempt a rollback if we did begin in the first place
if ($txn_begin_ok) {
}
}
- push @{ $weakself->exception_stack }, $run_err;
+ push @{ $self->exception_stack }, $run_err;
+
+ # this will throw if max_attempts is reached
+ $self->_set_failed_attempt_count($self->failed_attempt_count + 1);
# init depth of > 0 ( > 1 with AC) implies nesting - no retry attempt queries
$storage->throw_exception($run_err) if (
# FIXME - we assume that $storage->{_dbh_autocommit} is there if
# txn_init_depth is there, but this is a DBI-ism
$txn_init_depth > ( $storage->{_dbh_autocommit} ? 0 : 1 )
- ) or ! $weakself->retry_handler->($weakself)
+ ) or ! $self->retry_handler->($self)
);
- $weakself->_set_retried_count($weakself->retried_count + 1);
-
# we got that far - let's retry
- carp( sprintf 'Retrying %s (run %d) after caught exception: %s',
- $weakself->run_code,
- $weakself->retried_count + 1,
+ carp( sprintf 'Retrying %s (attempt %d) after caught exception: %s',
+ $cref,
+ $self->failed_attempt_count + 1,
$run_err,
- ) if $weakself->retry_debug;
+ ) if $self->retry_debug;
$storage->ensure_connected;
# if txn_depth is > 1 this means something was done to the
- # original $dbh, otherwise we would not get past the preceeding if()
+ # original $dbh, otherwise we would not get past the preceding if()
$storage->throw_exception(sprintf
'Unexpected transaction depth of %d on freshly connected handle',
$storage->transaction_depth,
) if (defined $txn_init_depth and $storage->transaction_depth);
- return $weakself->_run;
+ return $self->_run($cref, @$args);
}
return wantarray ? @res : $res[0];
projects / dbsrgits/DBIx-Class.git / blobdiff