From: Rafael Kitover <rkitover@cpan.org>
Date: Fri, 22 May 2009 02:54:12 +0000 (+0000)
Subject: add some support for trying to determine storage driver without being connected
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d40080c39809e75e0aa8b949ea157e274db1b66d;p=dbsrgits%2FDBIx-Class-Historic.git

add some support for trying to determine storage driver without being connected
---

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 8c4790e..dc66cb6 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -614,18 +614,12 @@ sub _populate_dbh {
   my @info = @{$self->_dbi_connect_info || []};
   $self->_dbh($self->_connect(@info));
 
+  $self->_determine_driver;
+
   # Always set the transaction depth on connect, since
   #  there is no transaction in progress by definition
   $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
 
-  if(ref $self eq 'DBIx::Class::Storage::DBI') {
-    my $driver = $self->_dbh->{Driver}->{Name};
-    if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
-      bless $self, "DBIx::Class::Storage::DBI::${driver}";
-      $self->_rebless();
-    }
-  }
-
   $self->_conn_pid($$);
   $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
 
@@ -633,6 +627,27 @@ sub _populate_dbh {
   $self->_do_connection_actions($connection_do) if $connection_do;
 }
 
+sub _determine_driver {
+  my ($self) = @_;
+
+  if (ref $self eq 'DBIx::Class::Storage::DBI') {
+    my $driver;
+
+    if ($self->_dbh) { # we are connected
+      $driver = $self->_dbh->{Driver}{Name};
+    } else {
+      # try to use dsn to not require being connected, the driver may still
+      # force a connection in _rebless to determine version
+      ($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i;
+    }
+
+    if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
+      bless $self, "DBIx::Class::Storage::DBI::${driver}";
+      $self->_rebless();
+    }
+  }
+}
+
 sub _do_connection_actions {
   my $self = shift;
   my $connection_do = shift;
diff --git a/lib/DBIx/Class/Storage/DBI/ODBC.pm b/lib/DBIx/Class/Storage/DBI/ODBC.pm
index e8b9c12..09a7c6b 100644
--- a/lib/DBIx/Class/Storage/DBI/ODBC.pm
+++ b/lib/DBIx/Class/Storage/DBI/ODBC.pm
@@ -7,7 +7,7 @@ use base qw/DBIx::Class::Storage::DBI/;
 sub _rebless {
     my ($self) = @_;
 
-    my $dbtype = eval { $self->_dbh->get_info(17) };
+    my $dbtype = eval { $self->dbh->get_info(17) };
     unless ( $@ ) {
         # Translate the backend name into a perl identifier
         $dbtype =~ s/\W/_/gi;
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm
index 29bfce1..f8f981b 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm
@@ -8,7 +8,7 @@ use base qw/DBIx::Class::Storage::DBI/;
 sub _rebless {
     my ($self) = @_;
 
-    my $version = eval { $self->_dbh->get_info(18); };
+    my $version = eval { $self->dbh->get_info(18); };
 
     if ( !$@ ) {
         my ($major, $minor, $patchlevel) = split(/\./, $version);
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index 1b50a70..8f1e766 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -142,9 +142,9 @@ This class defines the following methods.
 
 =head2 connect_replicants ($schema, Array[$connect_info])
 
-Given an array of $dsn suitable for connected to a database, create an
-L<DBIx::Class::Storage::DBI::Replicated::Replicant> object and store it in the
-L</replicants> attribute.
+Given an array of $dsn or connect_info structures suitable for connected to a
+database, create an L<DBIx::Class::Storage::DBI::Replicated::Replicant> object
+and store it in the L</replicants> attribute.
 
 =cut
 
@@ -184,7 +184,17 @@ sub connect_replicant {
   my ($self, $schema, $connect_info) = @_;
   my $replicant = $self->create_replicant($schema);
   $replicant->connect_info($connect_info);
-  $self->_safely_ensure_connected($replicant);
+
+## It is undesirable for catalyst to connect at ->conect_replicants time, as
+## connections should only happen on the first request that uses the database.
+## So we try to set the driver without connecting, however this doesn't always
+## work, as a driver may need to connect to determine the DB version, and this
+## may fail.
+
+  $self->_safely($replicant, '->_determine_driver', sub {
+    $replicant->_determine_driver
+  });
+
   DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant);  
   return $replicant;
 }
@@ -195,21 +205,39 @@ The standard ensure_connected method with throw an exception should it fail to
 connect.  For the master database this is desirable, but since replicants are
 allowed to fail, this behavior is not desirable.  This method wraps the call
 to ensure_connected in an eval in order to catch any generated errors.  That
-way a slave to go completely offline (ie, the box itself can die) without
+way a slave can go completely offline (ie, the box itself can die) without
 bringing down your entire pool of databases.
 
 =cut
 
 sub _safely_ensure_connected {
   my ($self, $replicant, @args) = @_;
+
+  return $self->_safely($replicant, '->ensure_connected', sub {
+    $replicant->ensure_connected(@args)
+  });
+}
+
+=head2 _safely ($replicant, $name, $code)
+
+Execute C<$code> for operation C<$name> catching any exceptions and printing an
+error message to the C<<$replicant->debugobj>>.
+
+Returns 1 on success and undef on failure.
+
+=cut
+
+sub _safely {
+  my ($self, $replicant, $name, $code) = @_;
+
   eval {
-    $replicant->ensure_connected(@args);
+    $code->()
   }; 
   if ($@) {
     $replicant
       ->debugobj
       ->print(
-        sprintf( "Exception trying to ->ensure_connected for replicant %s, error is %s",
+        sprintf( "Exception trying to $name for replicant %s, error is %s",
           $replicant->_dbi_connect_info->[0], $@)
         );
   	return;
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm
index f1a8dc8..670e55c 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm
@@ -8,7 +8,7 @@ use base qw/DBIx::Class::Storage::DBI::NoBindVars/;
 sub _rebless {
     my $self = shift;
 
-    my $dbtype = eval { @{$self->_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2] };
+    my $dbtype = eval { @{$self->dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2] };
     unless ( $@ ) {
         $dbtype =~ s/\W/_/gi;
         my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}";