From: Peter Rabbitson Date: Wed, 22 Jan 2014 12:00:47 +0000 (+0100) Subject: Massive incompatible change of ::BlockRunner internals X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7d534e689b7f9820dda4272bf6702fc3e9e86f0d;p=dbsrgits%2FDBIx-Class-Historic.git Massive incompatible change of ::BlockRunner internals It was never documented as usable externally (though folks do use it, sigh) This last set of changes settles the design for proper documentation and opening up --- diff --git a/251_TODO b/251_TODO index d2db9c6..4d77269 100644 --- a/251_TODO +++ b/251_TODO @@ -3,5 +3,3 @@ of importance: (Keep Getty happy) - Clarify/warn on the distinct over multiple columns get_column() -- Incompatibly move around pieces of BlockRunner (critical - people are - starting to rely on it) diff --git a/Changes b/Changes index a3db389..cc470b6 100644 --- a/Changes +++ b/Changes @@ -40,6 +40,9 @@ Revision history for DBIx::Class - Fix warning in t/54taint.t with explicitly unset PERL5LIB (RT#91972) * Misc + - Massive incompatible change of ::BlockRunner internals (was never + documented as usable externally, this last set of changes settles + the design for proper documentation and opening up) - Adjust exceptions in tests to accommodate changes in the upcoming DBD::SQLite based on libsqlite 3.8.2 - Replace $row with $result in all docs to be consistent and to diff --git a/Makefile.PL b/Makefile.PL index b9d1661..ac2dfd4 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -74,7 +74,7 @@ my $runtime_requires = { 'Data::Page' => '2.00', 'Devel::GlobalDestruction' => '0.09', 'Hash::Merge' => '0.12', - 'Moo' => '1.000006', + 'Moo' => '1.002', 'MRO::Compat' => '0.12', 'Module::Find' => '0.07', 'namespace::clean' => '0.24', diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm index 470911b..5cc1fe1 100644 --- a/lib/DBIx/Class/Storage.pm +++ b/lib/DBIx/Class/Storage.pm @@ -175,18 +175,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 diff --git a/lib/DBIx/Class/Storage/BlockRunner.pm b/lib/DBIx/Class/Storage/BlockRunner.pm index 5760b7d..05fe475 100644 --- a/lib/DBIx/Class/Storage/BlockRunner.pm +++ b/lib/DBIx/Class/Storage/BlockRunner.pm @@ -5,9 +5,10 @@ use Sub::Quote 'quote_sub'; use DBIx::Class::Exception; use DBIx::Class::Carp; use Context::Preserve 'preserve_context'; -use Scalar::Util qw/weaken blessed/; +use Scalar::Util qw(weaken blessed reftype); use Try::Tiny; use Moo; +use warnings NONFATAL => 'all'; use namespace::clean; =head1 NAME @@ -34,52 +35,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{ $_[0]->throw_exception( 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); + 'Reached max_attempts amount of %d, latest exception: %s', + $_[0]->max_attempts, $_[0]->last_exception + )) if $_[0]->max_attempts <= ($_[1]||0); }), ); @@ -98,28 +82,35 @@ sub throw_exception { shift->storage->throw_exception (@_) } sub run { my $self = shift; - $self->throw_exception('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 @@ -128,15 +119,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 @@ -144,7 +133,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 '') { @@ -156,7 +145,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 { @@ -184,7 +173,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 ( @@ -194,17 +186,15 @@ 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 @@ -214,7 +204,7 @@ sub _run { $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]; diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index bf239e6..23a7f71 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -822,7 +822,7 @@ Example: sub dbh_do { my $self = shift; - my $run_target = shift; + my $run_target = shift; # either a coderef or a method name # short circuit when we know there is no need for a runner # @@ -839,10 +839,15 @@ sub dbh_do { DBIx::Class::Storage::BlockRunner->new( storage => $self, - run_code => sub { $self->$run_target ($self->_get_dbh, @$args ) }, wrap_txn => 0, - retry_handler => sub { ! ( $_[0]->retried_count or $_[0]->storage->connected ) }, - )->run; + retry_handler => sub { + $_[0]->failed_attempt_count == 1 + and + ! $_[0]->storage->connected + }, + )->run(sub { + $self->$run_target ($self->_get_dbh, @$args ) + }); } sub txn_do { diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index dcb1b8f..d763953 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -285,7 +285,7 @@ sub _ping { sub _dbh_execute { #my ($self, $dbh, $sql, $bind, $bind_attrs) = @_; - my ($self, $bind) = @_[0,3]; + my ($self, $sql, $bind) = @_[0,2,3]; # Turn off sth caching for multi-part LOBs. See _prep_for_execute below local $self->{disable_sth_caching} = 1 if first { @@ -300,26 +300,31 @@ sub _dbh_execute { return shift->$next(@_) if $self->transaction_depth; - # cheat the blockrunner - we do want to rerun things regardless of outer state + # cheat the blockrunner we are just about to create + # we do want to rerun things regardless of outer state local $self->{_in_do_block}; return DBIx::Class::Storage::BlockRunner->new( storage => $self, - run_code => $next, - run_args => \@_, wrap_txn => 0, retry_handler => sub { # ORA-01003: no statement parsed (someone changed the table somehow, # invalidating your cursor.) - return 0 if ($_[0]->retried_count or $_[0]->last_exception !~ /ORA-01003/); - - # re-prepare towards new table data - if (my $dbh = $_[0]->storage->_dbh) { - delete $dbh->{CachedKids}{$_[0]->run_args->[2]}; + if ( + $_[0]->failed_attempt_count == 1 + and + $_[0]->last_exception =~ /ORA-01003/ + and + my $dbh = $_[0]->storage->_dbh + ) { + delete $dbh->{CachedKids}{$sql}; + return 1; + } + else { + return 0; } - return 1; }, - )->run; + )->run( $next, @_ ); } sub _dbh_execute_for_fetch { diff --git a/t/storage/txn.t b/t/storage/txn.t index 09260f0..efe3641 100644 --- a/t/storage/txn.t +++ b/t/storage/txn.t @@ -26,9 +26,10 @@ my $code = sub { (ref $schema)->txn_do(sub{}); }, qr/storage/, "can't call txn_do without storage"); - throws_ok ( sub { + throws_ok { $schema->txn_do(''); - }, qr/must be a CODE reference/, '$coderef parameter check ok'); + } qr/\Qrun() requires a coderef to execute as its first argument/, + '$coderef parameter check ok'; } # Test successful txn_do() - scalar/list context