From: Peter Rabbitson Date: Sun, 31 Mar 2013 13:06:59 +0000 (+0200) Subject: Refactor sth preparation/binding - no functional changes X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9930caaf7e7c250d914cb1440d9a0f1dd2a1dedc;p=dbsrgits%2FDBIx-Class-Historic.git Refactor sth preparation/binding - no functional changes Notable internal changes: - _dbi_attrs_for_bind call is moved out of _dbh_execute - there is no point recalculating these on retry - _dbh_execute changed signature: $ident => $bind_attrs - sth, _sth and _dbh_sth are no more - instead we now have _prepare_sth and _bind_sth_params The test in t/storage/base.t has not been actually working for years (it did not register a spurious success with $count == 0). Removing it is safe as t/storage/reconnect.t tests the same codepath more thoroughly --- diff --git a/Changes b/Changes index 3863adf..274345e 100644 --- a/Changes +++ b/Changes @@ -3,6 +3,7 @@ Revision history for DBIx::Class * New Features / Changes - Officially deprecate the 'cols' and 'include_columns' resultset attributes + - Remove ::Storage::DBI::sth() deprecated in 0.08191 * Fixes - Audit and correct potential bugs associated with braindead reuse diff --git a/lib/DBIx/Class/CDBICompat/ImaDBI.pm b/lib/DBIx/Class/CDBICompat/ImaDBI.pm index 85aced2..aaa19a0 100644 --- a/lib/DBIx/Class/CDBICompat/ImaDBI.pm +++ b/lib/DBIx/Class/CDBICompat/ImaDBI.pm @@ -88,7 +88,9 @@ sub set_sql { sub { my $sql = $sql; my $class = shift; - return $class->storage->_sth($class->transform_sql($sql, @_)); + return $class->storage->dbh_do( + _prepare_sth => $class->transform_sql($sql, @_) + ); }; if ($sql =~ /select/i) { my $search_name = "search_${name}"; diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 0a60e73..1018638 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1706,22 +1706,63 @@ sub _execute { my ($sql, $bind) = $self->_prep_for_execute($op, $ident, \@args); - shift->dbh_do( # retry over disconnects - '_dbh_execute', + shift->dbh_do( _dbh_execute => # retry over disconnects $sql, $bind, - $ident, + $self->_dbi_attrs_for_bind($ident, $bind), ); } sub _dbh_execute { - my ($self, undef, $sql, $bind, $ident) = @_; + my ($self, $dbh, $sql, $bind, $bind_attrs) = @_; $self->_query_start( $sql, $bind ); - my $bind_attrs = $self->_dbi_attrs_for_bind($ident, $bind); + my $sth = $self->_bind_sth_params( + $self->_prepare_sth($dbh, $sql), + $bind, + $bind_attrs, + ); + + # Can this fail without throwing an exception anyways??? + my $rv = $sth->execute(); + $self->throw_exception( + $sth->errstr || $sth->err || 'Unknown error: execute() returned false, but error flags were not set...' + ) if !$rv; + + $self->_query_end( $sql, $bind ); - my $sth = $self->_sth($sql); + return (wantarray ? ($rv, $sth, @$bind) : $rv); +} + +sub _prepare_sth { + my ($self, $dbh, $sql) = @_; + + # 3 is the if_active parameter which avoids active sth re-use + my $sth = $self->disable_sth_caching + ? $dbh->prepare($sql) + : $dbh->prepare_cached($sql, {}, 3); + + # XXX You would think RaiseError would make this impossible, + # but apparently that's not true :( + $self->throw_exception( + $dbh->errstr + || + sprintf( "\$dbh->prepare() of '%s' through %s failed *silently* without " + .'an exception and/or setting $dbh->errstr', + length ($sql) > 20 + ? substr($sql, 0, 20) . '...' + : $sql + , + 'DBD::' . $dbh->{Driver}{Name}, + ) + ) if !$sth; + + $sth; +} + +sub _bind_sth_params { + my ($self, $sth, $bind, $bind_attrs) = @_; for my $i (0 .. $#$bind) { if (ref $bind->[$i][1] eq 'SCALAR') { # any scalarrefs are assumed to be bind_inouts @@ -1744,15 +1785,7 @@ sub _dbh_execute { } } - # Can this fail without throwing an exception anyways??? - my $rv = $sth->execute(); - $self->throw_exception( - $sth->errstr || $sth->err || 'Unknown error: execute() returned false, but error flags were not set...' - ) if !$rv; - - $self->_query_end( $sql, $bind ); - - return (wantarray ? ($rv, $sth, @$bind) : $rv); + $sth; } sub _prefetch_autovalues { @@ -2080,7 +2113,7 @@ sub insert_bulk { my $guard = $self->txn_scope_guard; $self->_query_start( $sql, @$proto_bind ? [[undef => '__BULK_INSERT__' ]] : () ); - my $sth = $self->_sth($sql); + my $sth = $self->_prepare_sth($self->_dbh, $sql); my $rv = do { if (@$proto_bind) { # proto bind contains the information on which pieces of $data to pull @@ -2387,42 +2420,6 @@ see L. =cut -sub _dbh_sth { - my ($self, $dbh, $sql) = @_; - - # 3 is the if_active parameter which avoids active sth re-use - my $sth = $self->disable_sth_caching - ? $dbh->prepare($sql) - : $dbh->prepare_cached($sql, {}, 3); - - # XXX You would think RaiseError would make this impossible, - # but apparently that's not true :( - $self->throw_exception( - $dbh->errstr - || - sprintf( "\$dbh->prepare() of '%s' through %s failed *silently* without " - .'an exception and/or setting $dbh->errstr', - length ($sql) > 20 - ? substr($sql, 0, 20) . '...' - : $sql - , - 'DBD::' . $dbh->{Driver}{Name}, - ) - ) if !$sth; - - $sth; -} - -sub sth { - carp_unique 'sth was mistakenly marked/documented as public, stop calling it (will be removed before DBIC v0.09)'; - shift->_sth(@_); -} - -sub _sth { - my ($self, $sql) = @_; - $self->dbh_do('_dbh_sth', $sql); # retry over disconnects -} - sub _dbh_columns_info_for { my ($self, $dbh, $table) = @_; diff --git a/lib/DBIx/Class/Storage/DBI/ADO.pm b/lib/DBIx/Class/Storage/DBI/ADO.pm index 0e5c286..705a598 100644 --- a/lib/DBIx/Class/Storage/DBI/ADO.pm +++ b/lib/DBIx/Class/Storage/DBI/ADO.pm @@ -67,7 +67,7 @@ sub _init { # Here I was just experimenting with ADO cursor types, left in as a comment in # case you want to as well. See the DBD::ADO docs. -#sub _dbh_sth { +#sub _prepare_sth { # my ($self, $dbh, $sql) = @_; # # my $sth = $self->disable_sth_caching diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index af68023..568b561 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -284,7 +284,7 @@ sub _ping { } sub _dbh_execute { - #my ($self, $dbh, $sql, $bind, $ident) = @_; + #my ($self, $dbh, $sql, $bind, $bind_attrs) = @_; my ($self, $bind) = @_[0,3]; # Turn off sth caching for multi-part LOBs. See _prep_for_execute below diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index adfe403..c6b7b12 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -317,8 +317,6 @@ my $method_dispatch = { sql_maker_class _execute _do_query - _sth - _dbh_sth _dbh_execute /, Class::MOP::Class->initialize('DBIx::Class::Storage::DBIHacks')->get_method_list ], reader => [qw/ @@ -359,7 +357,8 @@ my $method_dispatch = { _is_binary_type _is_text_lob_type - sth + _prepare_sth + _bind_sth_params /,( # the capability framework # not sure if CMOP->initialize does evil things to DBIC::S::DBI, fix if a problem diff --git a/t/storage/base.t b/t/storage/base.t index 2aac70c..b16938b 100644 --- a/t/storage/base.t +++ b/t/storage/base.t @@ -8,33 +8,6 @@ use lib qw(t/lib); use DBICTest; use Data::Dumper; -{ - package DBICTest::ExplodingStorage::Sth; - use strict; - use warnings; - - sub execute { die "Kablammo!" } - - sub bind_param {} - - package DBICTest::ExplodingStorage; - use strict; - use warnings; - use base 'DBIx::Class::Storage::DBI::SQLite'; - - my $count = 0; - sub sth { - my ($self, $sql) = @_; - return bless {}, "DBICTest::ExplodingStorage::Sth" unless $count++; - return $self->next::method($sql); - } - - sub connected { - return 0 if $count == 1; - return shift->next::method(@_); - } -} - my $schema = DBICTest->init_schema( sqlite_use_file => 1 ); is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite', @@ -51,16 +24,6 @@ throws_ok { $schema->resultset('CD')->search_literal('broken +%$#$1')->all; } qr/prepare_cached failed/, 'exception via DBI->HandleError, etc'; -bless $storage, "DBICTest::ExplodingStorage"; -$schema->storage($storage); - -lives_ok { - $schema->resultset('Artist')->create({ name => "Exploding Sheep" }); -} 'Exploding $sth->execute was caught'; - -is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count, - "And the STH was retired"); - # testing various invocations of connect_info ([ ... ]) diff --git a/t/storage/disable_sth_caching.t b/t/storage/disable_sth_caching.t index c32f8c7..d6dcc03 100644 --- a/t/storage/disable_sth_caching.t +++ b/t/storage/disable_sth_caching.t @@ -5,15 +5,22 @@ use Test::More; use lib qw(t/lib); use DBICTest; -plan tests => 2; +##!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +## This test uses undocumented internal methods +## DO NOT USE THEM IN THE SAME MANNER +## They are subject to ongoing change +##!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! # Set up the "usual" sqlite for DBICTest my $schema = DBICTest->init_schema; +my $dbh = $schema->storage->_get_dbh; -my $sth_one = $schema->storage->_sth('SELECT 42'); -my $sth_two = $schema->storage->_sth('SELECT 42'); +my $sth_one = $schema->storage->_prepare_sth($dbh, 'SELECT 42'); +my $sth_two = $schema->storage->_prepare_sth($dbh, 'SELECT 42'); $schema->storage->disable_sth_caching(1); -my $sth_three = $schema->storage->_sth('SELECT 42'); +my $sth_three = $schema->storage->_prepare_sth($dbh, 'SELECT 42'); ok($sth_one == $sth_two, "statement caching works"); ok($sth_two != $sth_three, "disabling statement caching works"); + +done_testing;