X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FBlockRunner.pm;h=8dae0c9be71dd4d9f8fdfa21e7609044712f94dd;hb=59d624cf78c63416f50aceff6391b8b80227e4f5;hp=8b9ea2659fd8ff55f32acddad7aed7b3196d4ec0;hpb=0c11ad0ee5c8407f6b87d6e15c62a1b445076dc0;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/BlockRunner.pm b/lib/DBIx/Class/Storage/BlockRunner.pm index 8b9ea26..8dae0c9 100644 --- a/lib/DBIx/Class/Storage/BlockRunner.pm +++ b/lib/DBIx/Class/Storage/BlockRunner.pm @@ -1,13 +1,22 @@ 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 @@ -34,52 +43,35 @@ has wrap_txn => ( 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); }), ); @@ -93,31 +85,40 @@ has exception_stack => ( 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 @@ -126,15 +127,13 @@ sub _run { 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 @@ -142,7 +141,7 @@ sub _run { } 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 '') { @@ -154,7 +153,7 @@ sub _run { '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 { @@ -163,7 +162,7 @@ sub _run { } # 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) { @@ -182,7 +181,10 @@ sub _run { } } - 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 ( @@ -192,27 +194,25 @@ sub _run { # 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];