From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sun, 31 Mar 2013 13:06:59 +0000 (+0200)
Subject: Refactor sth preparation/binding - no functional changes
X-Git-Tag: v0.08210~10
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9930caaf7e7c250d914cb1440d9a0f1dd2a1dedc;p=dbsrgits%2FDBIx-Class.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<DBIx::Class::SQLMaker::LimitDialects>.
 
 =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;