Caelum was right to make _get_dbh private - reverting (and some code refactoring)

diff --git a/Changes b/Changes
index 5918ec2..72aa3a4 100644 (file)
--- a/Changes
+++ b/Changes
@@ -33,9 +33,6 @@ Revision history for DBIx::Class
             prefetch
         - Massive optimization of the DBI storage layer - reduce the
           amount of connected() calls
-        - New ::Storage::DBI method last_dbh() - it will still return a
-          newly connected $dbh if we start unconnected, but will not ping
-          the server on every invocation unlike dbh()
         - Some fixes of multi-create corner cases
         - Multiple POD improvements
         - Added exception when resultset is called without an argument

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 9fdb67c..42867ba 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -452,7 +452,11 @@ sub connect_info {
 }
 
 sub _default_dbi_connect_attributes {
-  return { AutoCommit => 1 };
+  return {
+    AutoCommit => 1,
+    RaiseError => 1,
+    PrintError => 0,
+  };
 }
 
 =head2 on_connect_do
@@ -551,6 +555,7 @@ sub dbh_do {
     }
   };
 
+  # ->connected might unset $@ - copy
   my $exception = $@;
   if(!$exception) { return $want_array ? @result : $result[0] }
 
@@ -598,6 +603,7 @@ sub txn_do {
       $self->txn_commit;
     };
 
+    # ->connected might unset $@ - copy
     my $exception = $@;
     if(!$exception) { return $want_array ? @result : $result[0] }
 
@@ -687,22 +693,32 @@ answering, etc.) This method is used internally by L</dbh>.
 =cut
 
 sub connected {
-  my ($self) = @_;
+  my $self = shift;
+  return 0 unless $self->_seems_connected;
 
-  if(my $dbh = $self->_dbh) {
-      if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
-          $self->_dbh(undef);
-          $self->{_dbh_gen}++;
-          return;
-      }
-      else {
-          $self->_verify_pid;
-          return 0 if !$self->_dbh;
-      }
-      return ($dbh->FETCH('Active') && $self->_ping);
+  #be on the safe side
+  local $self->_dbh->{RaiseError} = 1;
+
+  return $self->_ping;
+}
+
+sub _seems_connected {
+  my $self = shift;
+
+  my $dbh = $self->_dbh
+    or return 0;
+
+  if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
+    $self->_dbh(undef);
+    $self->{_dbh_gen}++;
+    return 0;
+  }
+  else {
+    $self->_verify_pid;
+    return 0 if !$self->_dbh;
   }
 
-  return 0;
+  return $dbh->FETCH('Active');
 }
 
 sub _ping {
@@ -739,7 +755,9 @@ sub ensure_connected {
 
 Returns a C<$dbh> - a data base handle of class L<DBI>. The returned handle
 is guaranteed to be healthy by implicitly calling L</connected>, and if
-necessary performing a reconnection before returning.
+necessary performing a reconnection before returning. Keep in mind that this
+is very B<expensive> on some database engines. Consider using L<dbh_do>
+instead.
 
 =cut
 
@@ -754,17 +772,8 @@ sub dbh {
   return $self->_dbh;
 }
 
-=head2 last_dbh
-
-This returns the B<last> available C<$dbh> if any, or attempts to
-connect and returns the resulting handle. This method differs from
-L</dbh> by not validating if a preexisting handle is still healthy
-via L</connected>. Make sure you take appropriate precautions
-when using this method, as the C<$dbh> may be useless at this point.
-
-=cut
-
-sub last_dbh {
+# this is the internal "get dbh or connect (don't check)" method
+sub _get_dbh {
   my $self = shift;
   $self->_populate_dbh unless $self->_dbh;
   return $self->_dbh;
@@ -776,7 +785,7 @@ sub _sql_maker_args {
     return (
       bindtype=>'columns',
       array_datatypes => 1,
-      limit_dialect => $self->last_dbh,
+      limit_dialect => $self->_get_dbh,
       %{$self->_sql_maker_opts}
     );
 }
@@ -797,6 +806,7 @@ sub _populate_dbh {
   my ($self) = @_;
 
   my @info = @{$self->_dbi_connect_info || []};
+  $self->_dbh(undef); # in case ->connected failed we might get sent here
   $self->_dbh($self->_connect(@info));
 
   $self->_conn_pid($$);
@@ -1235,7 +1245,7 @@ sub insert {
         $updated_cols->{$col} = $to_insert->{$col} = $self->_sequence_fetch(
           'nextval',
           $col_info->{sequence} ||
-            $self->_dbh_get_autoinc_seq($self->last_dbh, $source)
+            $self->_dbh_get_autoinc_seq($self->_get_dbh, $source)
         );
       }
     }
@@ -2025,7 +2035,7 @@ Returns the database driver name.
 
 =cut
 
-sub sqlt_type { shift->last_dbh->{Driver}->{Name} }
+sub sqlt_type { shift->_get_dbh->{Driver}->{Name} }
 
 =head2 bind_attribute_by_data_type
 
@@ -2271,8 +2281,6 @@ See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>.
 
 sub deployment_statements {
   my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
-  # Need to be connected to get the correct sqlt_type
-  $self->last_dbh() unless $type;
   $type ||= $self->sqlt_type;
   $version ||= $schema->schema_version || '1.x';
   $dir ||= './';
@@ -2317,10 +2325,9 @@ sub deploy {
     return if $line =~ /^\s+$/; # skip whitespace only
     $self->_query_start($line);
     eval {
-      # a previous error may invalidate $dbh - thus we need to use dbh()
-      # to guarantee a healthy $dbh (this is temporary until we get
-      # proper error handling on deploy() )
-      $self->dbh->do($line);
+      # do a dbh_do cycle here, as we need some error checking in
+      # place (even though we will ignore errors)
+      $self->dbh_do (sub { $_[1]->do($line) });
     };
     if ($@) {
       carp qq{$@ (running "${line}")};
@@ -2349,7 +2356,7 @@ Returns the datetime parser class
 sub datetime_parser {
   my $self = shift;
   return $self->{datetime_parser} ||= do {
-    $self->last_dbh;
+    $self->_populate_dbh unless $self->_dbh;
     $self->build_datetime_parser(@_);
   };
 }

diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
index 674d458..b0da553 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
@@ -30,14 +30,14 @@ sub insert_bulk {
 
   if ($identity_insert) {
     my $table = $source->from;
-    $self->last_dbh->do("SET IDENTITY_INSERT $table ON");
+    $self->_get_dbh->do("SET IDENTITY_INSERT $table ON");
   }
 
   $self->next::method(@_);
 
   if ($identity_insert) {
     my $table = $source->from;
-    $self->last_dbh->do("SET IDENTITY_INSERT $table OFF");
+    $self->_get_dbh->do("SET IDENTITY_INSERT $table OFF");
   }
 }
 
@@ -68,7 +68,7 @@ sub insert {
     grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
 
   for my $guid_col (@get_guids_for) {
-    my ($new_guid) = $self->last_dbh->selectrow_array('SELECT NEWID()');
+    my ($new_guid) = $self->_get_dbh->selectrow_array('SELECT NEWID()');
     $updated_cols->{$guid_col} = $to_insert->{$guid_col} = $new_guid;
   }
 
@@ -145,7 +145,7 @@ sub last_insert_id { shift->_identity }
 sub _svp_begin {
   my ($self, $name) = @_;
 
-  $self->last_dbh->do("SAVE TRANSACTION $name");
+  $self->_get_dbh->do("SAVE TRANSACTION $name");
 }
 
 # A new SAVE TRANSACTION with the same name releases the previous one.
@@ -154,7 +154,7 @@ sub _svp_release { 1 }
 sub _svp_rollback {
   my ($self, $name) = @_;
 
-  $self->last_dbh->do("ROLLBACK TRANSACTION $name");
+  $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
 }
 
 sub build_datetime_parser {

diff --git a/lib/DBIx/Class/Storage/DBI/ODBC.pm b/lib/DBIx/Class/Storage/DBI/ODBC.pm
index 7c3b739..d9b810a 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/ODBC.pm
+++ b/lib/DBIx/Class/Storage/DBI/ODBC.pm
@@ -8,7 +8,7 @@ use mro 'c3';
 sub _rebless {
     my ($self) = @_;
 
-    my $dbtype = eval { $self->last_dbh->get_info(17) };
+    my $dbtype = eval { $self->_get_dbh->get_info(17) };
 
     unless ( $@ ) {
         # Translate the backend name into a perl identifier

diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
index 77c20ad..5279502 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
@@ -137,7 +137,7 @@ sub connect_call_use_server_cursors {
   my $self            = shift;
   my $sql_rowset_size = shift || 2;
 
-  $self->_dbh->{odbc_SQL_ROWSET_SIZE} = $sql_rowset_size;
+  $self->_get_dbh->{odbc_SQL_ROWSET_SIZE} = $sql_rowset_size;
 }
 
 =head2 connect_call_use_MARS
@@ -165,9 +165,9 @@ sub connect_call_use_MARS {
 
   if ($dsn !~ /MARS_Connection=/) {
     $self->_dbi_connect_info->[0] = "$dsn;MARS_Connection=Yes";
-    my $connected = defined $self->_dbh;
+    my $was_connected = defined $self->_dbh;
     $self->disconnect;
-    $self->ensure_connected if $connected;
+    $self->ensure_connected if $was_connected;
   }
 }
 

diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm
index c0edb9a..7a49b50 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Oracle.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm
@@ -9,7 +9,7 @@ use mro 'c3';
 sub _rebless {
     my ($self) = @_;
 
-    my $version = eval { $self->last_dbh->get_info(18); };
+    my $version = eval { $self->_get_dbh->get_info(18); };
 
     if ( !$@ ) {
         my ($major, $minor, $patchlevel) = split(/\./, $version);

diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index 832da97..b97e34f 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -76,7 +76,7 @@ sub _dbh_get_autoinc_seq {
 
 sub _sequence_fetch {
   my ( $self, $type, $seq ) = @_;
-  my ($id) = $self->last_dbh->selectrow_array("SELECT ${seq}.${type} FROM DUAL");
+  my ($id) = $self->_get_dbh->selectrow_array("SELECT ${seq}.${type} FROM DUAL");
   return $id;
 }
 
@@ -209,7 +209,7 @@ sub connect_call_datetime_setup {
 sub _svp_begin {
     my ($self, $name) = @_;
 
-    $self->last_dbh->do("SAVEPOINT $name");
+    $self->_get_dbh->do("SAVEPOINT $name");
 }
 
 =head2 source_bind_attributes
@@ -263,7 +263,7 @@ sub _svp_release { 1 }
 sub _svp_rollback {
     my ($self, $name) = @_;
 
-    $self->last_dbh->do("ROLLBACK TO SAVEPOINT $name")
+    $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
 }
 
 =head1 AUTHOR

diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm
index 91418a4..a664808 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Pg.pm
+++ b/lib/DBIx/Class/Storage/DBI/Pg.pm
@@ -15,7 +15,7 @@ warn "DBD::Pg 2.9.2 or greater is strongly recommended\n"
 sub with_deferred_fk_checks {
   my ($self, $sub) = @_;
 
-  $self->last_dbh->do('SET CONSTRAINTS ALL DEFERRED');
+  $self->_get_dbh->do('SET CONSTRAINTS ALL DEFERRED');
   $sub->();
 }
 
@@ -90,26 +90,26 @@ sub bind_attribute_by_data_type {
 
 sub _sequence_fetch {
   my ( $self, $type, $seq ) = @_;
-  my ($id) = $self->last_dbh->selectrow_array("SELECT nextval('${seq}')");
+  my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
   return $id;
 }
 
 sub _svp_begin {
     my ($self, $name) = @_;
 
-    $self->last_dbh->pg_savepoint($name);
+    $self->_get_dbh->pg_savepoint($name);
 }
 
 sub _svp_release {
     my ($self, $name) = @_;
 
-    $self->last_dbh->pg_release($name);
+    $self->_get_dbh->pg_release($name);
 }
 
 sub _svp_rollback {
     my ($self, $name) = @_;
 
-    $self->last_dbh->pg_rollback_to($name);
+    $self->_get_dbh->pg_rollback_to($name);
 }
 
 1;

diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm
index c7031a1..41b0c81 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm
@@ -13,7 +13,7 @@ sub _rebless {
     my $self = shift;
 
     my $dbtype = eval {
-      @{$self->last_dbh
+      @{$self->_get_dbh
         ->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})
       }[2]
     };

diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm b/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
index b375a8c..757d4d9 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
@@ -29,7 +29,7 @@ sub _ping {
 
 sub _placeholders_supported {
   my $self = shift;
-  my $dbh  = $self->last_dbh;
+  my $dbh  = $self->_get_dbh;
 
   return eval {
 # There's also $dbh->{syb_dynamic_supported} but it can be inaccurate for this

diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
index 6cda222..6a20ba4 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
@@ -11,7 +11,7 @@ use mro 'c3';
 
 sub _rebless {
   my $self = shift;
-  my $dbh  = $self->last_dbh;
+  my $dbh  = $self->_get_dbh;
 
   if (not $self->_placeholders_supported) {
     bless $self,

diff --git a/lib/DBIx/Class/Storage/DBI/mysql.pm b/lib/DBIx/Class/Storage/DBI/mysql.pm
index 89c8f89..6224d53 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/mysql.pm
+++ b/lib/DBIx/Class/Storage/DBI/mysql.pm
@@ -40,28 +40,28 @@ sub sqlt_type {
 sub _svp_begin {
     my ($self, $name) = @_;
 
-    $self->last_dbh->do("SAVEPOINT $name");
+    $self->_get_dbh->do("SAVEPOINT $name");
 }
 
 sub _svp_release {
     my ($self, $name) = @_;
 
-    $self->last_dbh->do("RELEASE SAVEPOINT $name");
+    $self->_get_dbh->do("RELEASE SAVEPOINT $name");
 }
 
 sub _svp_rollback {
     my ($self, $name) = @_;
 
-    $self->last_dbh->do("ROLLBACK TO SAVEPOINT $name")
+    $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
 }
 
 sub is_replicating {
-    my $status = shift->last_dbh->selectrow_hashref('show slave status');
+    my $status = shift->_get_dbh->selectrow_hashref('show slave status');
     return ($status->{Slave_IO_Running} eq 'Yes') && ($status->{Slave_SQL_Running} eq 'Yes');
 }
 
 sub lag_behind_master {
-    return shift->last_dbh->selectrow_hashref('show slave status')->{Seconds_Behind_Master};
+    return shift->_get_dbh->selectrow_hashref('show slave status')->{Seconds_Behind_Master};
 }
 
 # MySql can not do subquery update/deletes, only way is slow per-row operations.

diff --git a/t/92storage_ping_count.t b/t/92storage_ping_count.t
index 9dddd64..07659cb 100644 (file)
--- a/t/92storage_ping_count.t
+++ b/t/92storage_ping_count.t
@@ -22,15 +22,13 @@ my $ping_count = 0;
 }
 
 
-# We do not count pings during deploy() because of the flux
-# around sqlt. Eventually there should be no pings at all
+# measure pings around deploy() separately
 my $schema = DBICTest->init_schema( sqlite_use_file => 1, no_populate => 1 );
 
-TODO: {
-  local $TODO = 'Unable to fix before proper deploy() error handling';
-  is ($ping_count, 0, 'no _ping() calls during deploy');
-  $ping_count = 0;
-}
+is ($ping_count, 0, 'no _ping() calls during deploy');
+$ping_count = 0;
+
+
 
 DBICTest->populate_schema ($schema);