[Bast-commits] r6366 - in DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage: . DBI DBI/Replicated

caelum at dev.catalyst.perl.org caelum at dev.catalyst.perl.org
Fri May 22 02:54:12 GMT 2009


Author: caelum
Date: 2009-05-22 02:54:12 +0000 (Fri, 22 May 2009)
New Revision: 6366

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase.pm
Log:
add some support for trying to determine storage driver without being connected

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC.pm	2009-05-22 01:21:33 UTC (rev 6365)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC.pm	2009-05-22 02:54:12 UTC (rev 6366)
@@ -7,7 +7,7 @@
 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;

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle.pm	2009-05-22 01:21:33 UTC (rev 6365)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle.pm	2009-05-22 02:54:12 UTC (rev 6366)
@@ -8,7 +8,7 @@
 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);

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm	2009-05-22 01:21:33 UTC (rev 6365)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm	2009-05-22 02:54:12 UTC (rev 6366)
@@ -142,9 +142,9 @@
 
 =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 @@
   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 @@
 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;

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase.pm	2009-05-22 01:21:33 UTC (rev 6365)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase.pm	2009-05-22 02:54:12 UTC (rev 6366)
@@ -8,7 +8,7 @@
 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}";

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2009-05-22 01:21:33 UTC (rev 6365)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2009-05-22 02:54:12 UTC (rev 6366)
@@ -614,18 +614,12 @@
   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 @@
   $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;




More information about the Bast-commits mailing list