Merge 'sybase' into 'trunk'

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Replicated / Pool.pm

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index e22f0a9..e5fa1a1 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -5,6 +5,7 @@ use MooseX::AttributeHelpers;
 use DBIx::Class::Storage::DBI::Replicated::Replicant;
 use List::Util 'sum';
 use Scalar::Util 'reftype';
+use DBI ();
 use Carp::Clan qw/^DBIx::Class/;
 use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
 
@@ -18,7 +19,7 @@ DBIx::Class::Storage::DBI::Replicated::Pool - Manage a pool of replicants
 
 This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.  You
 shouldn't need to create instances of this class.
-  
+
 =head1 DESCRIPTION
 
 In a replicated storage type, there is at least one replicant to handle the
@@ -34,7 +35,7 @@ This class defines the following attributes.
 This is a number which defines the maximum allowed lag returned by the
 L<DBIx::Class::Storage::DBI/lag_behind_master> method.  The default is 0.  In
 general, this should return a larger number when the replicant is lagging
-behind it's master, however the implementation of this is database specific, so
+behind its master, however the implementation of this is database specific, so
 don't count on this number having a fixed meaning.  For example, MySQL will
 return a number of seconds that the replicating database is lagging.
 
@@ -51,7 +52,7 @@ has 'maximum_lag' => (
 =head2 last_validated
 
 This is an integer representing a time since the last time the replicants were
-validated. It's nothing fancy, just an integer provided via the perl time 
+validated. It's nothing fancy, just an integer provided via the perl L<time|perlfunc/time>
 builtin.
 
 =cut
@@ -89,11 +90,11 @@ A hashref of replicant, with the key being the dsn and the value returning the
 actual replicant storage.  For example if the $dsn element is something like:
 
   "dbi:SQLite:dbname=dbfile"
-  
+
 You could access the specific replicant via:
 
   $schema->storage->replicants->{'dbname=dbfile'}
-  
+
 This attributes also supports the following helper methods:
 
 =over 4
@@ -129,11 +130,21 @@ has 'replicants' => (
   default=>sub {{}},
   provides  => {
     'set' => 'set_replicant',
-    'get' => 'get_replicant',            
+    'get' => 'get_replicant',
     'empty' => 'has_replicants',
     'count' => 'num_replicants',
     'delete' => 'delete_replicant',
-       'values' => 'all_replicant_storages',
+    'values' => 'all_replicant_storages',
+  },
+);
+
+has next_unknown_replicant_id => (
+  is => 'rw',
+  metaclass => 'Counter',
+  isa => Int,
+  default => 1,
+  provides => {
+    inc => 'inc_unknown_replicant_id'
   },
 );
 
@@ -152,25 +163,54 @@ and store it in the L</replicants> attribute.
 sub connect_replicants {
   my $self = shift @_;
   my $schema = shift @_;
-  
+
   my @newly_created = ();
   foreach my $connect_info (@_) {
     $connect_info = [ $connect_info ]
       if reftype $connect_info ne 'ARRAY';
 
-    croak "coderef replicant connect_info not supported"
-      if ref $connect_info->[0] && reftype $connect_info->[0] eq 'CODE';
-
-    my $replicant = $self->connect_replicant($schema, $connect_info);
+    my $connect_coderef =
+      (reftype($connect_info->[0])||'') eq 'CODE' ? $connect_info->[0]
+        : (reftype($connect_info->[0])||'') eq 'HASH' &&
+          $connect_info->[0]->{dbh_maker};
+
+    my $dsn;
+    my $replicant = do {
+# yes this is evil, but it only usually happens once (for coderefs)
+# this will fail if the coderef does not actually DBI::connect
+      no warnings 'redefine';
+      my $connect = \&DBI::connect;
+      local *DBI::connect = sub {
+        $dsn = $_[1];
+        goto $connect;
+      };
+      $self->connect_replicant($schema, $connect_info);
+    };
+
+    my $key;
+
+    if (!$dsn) {
+      if (!$connect_coderef) {
+        $dsn = $connect_info->[0];
+        $dsn = $dsn->{dsn} if (reftype($dsn)||'') eq 'HASH';
+      }
+      else {
+        # all attempts to get the DSN failed
+        $key = "UNKNOWN_" . $self->next_unknown_replicant_id;
+        $self->inc_unknown_replicant_id;
+      }
+    }
+    if ($dsn) {
+      $replicant->dsn($dsn);
+      ($key) = ($dsn =~ m/^dbi\:.+\:(.+)$/i);
+    }
 
-    my $key = $connect_info->[0];
-    $key = $key->{dsn} if ref $key && reftype $key eq 'HASH';
-    ($key) = ($key =~ m/^dbi\:.+\:(.+)$/);
+    $replicant->id($key);
+    $self->set_replicant($key => $replicant);  
 
-    $self->set_replicant( $key => $replicant);  
     push @newly_created, $replicant;
   }
-  
+
   return @newly_created;
 }