From: Rafael Kitover <rkitover@cpan.org>
Date: Mon, 31 Aug 2009 02:36:08 +0000 (+0000)
Subject: support coderef connect_infos for repicated storage
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0bd8e0585b592d2583f28b6922b47afa78559cf4;p=dbsrgits%2FDBIx-Class-Historic.git

support coderef connect_infos for repicated storage
---

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 6026cd4..436f540 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -876,10 +876,18 @@ sub _determine_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;
-        $started_unconnected = 1;
+        # if connect_info is a CODEREF, we have no choice but to connect
+        if (ref $self->_dbi_connect_info->[0] &&
+            Scalar::Util::reftype($self->_dbi_connect_info->[0]) eq 'CODE') {
+          $self->_populate_dbh;
+          $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;
+          $started_unconnected = 1;
+        }
       }
 
       my $storage_class = "DBIx::Class::Storage::DBI::${driver}";
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index ac9a877..ee43384 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -518,8 +518,15 @@ around connect_replicants => sub {
 # delete them
     splice @$r, $i+1, ($#{$r} - $i), ();
 
+# make sure master/replicants opts don't clash
+    my %master_opts = %{ $self->_master_connect_info_opts };
+    if (exists $opts{dbh_maker}) {
+        delete @master_opts{qw/dsn user password/};
+    }
+    delete $master_opts{dbh_maker};
+
 # merge with master
-    %opts = %{ merge(\%opts, $self->_master_connect_info_opts) };
+    %opts = %{ merge(\%opts, \%master_opts) };
 
 # update
     $r->[$i] = \%opts;
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index 44481c4..c31cd4d 100644
--- 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/;
 
@@ -158,16 +159,32 @@ sub connect_replicants {
     $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 $key = $connect_info->[0];
-    $key = $key->{dsn} if ref $key && reftype $key eq 'HASH';
-    ($key) = ($key =~ m/^dbi\:.+\:(.+)$/);
+    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;
+    if (not $connect_coderef) {
+      $dsn = $connect_info->[0];
+      $dsn = $dsn->{dsn} if (reftype($dsn)||'') eq 'HASH';
+    }
+    else {
+# yes this is evil, but it only usually happens once
+      no warnings 'redefine';
+      my $connect = \&DBI::connect;
+      local *DBI::connect = sub {
+        $dsn = $_[1];
+        goto $connect;
+      };
+      $connect_coderef->();
+    }
+    $replicant->dsn($dsn);
+    my ($key) = ($dsn =~ m/^dbi\:.+\:(.+)$/i);
 
-    $self->set_replicant( $key => $replicant);  
+    $self->set_replicant($key => $replicant);  
     push @newly_created, $replicant;
   }
 
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
index 2e9f9dd..8825cae 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
@@ -3,7 +3,7 @@ package DBIx::Class::Storage::DBI::Replicated::Replicant;
 use Moose::Role;
 requires qw/_query_start/;
 with 'DBIx::Class::Storage::DBI::Replicated::WithDSN';
-use MooseX::Types::Moose 'Bool';
+use MooseX::Types::Moose qw/Bool Str/;
 
 use namespace::clean -except => 'meta';
 
@@ -52,6 +52,11 @@ has 'active' => (
   default=>1,
 );
 
+has dsn => (
+  is => 'rw',
+  isa => Str,
+);
+
 =head1 METHODS
 
 This class defines the following methods.
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm b/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
index 6025739..a6fe522 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
@@ -1,6 +1,7 @@
 package DBIx::Class::Storage::DBI::Replicated::WithDSN;
 
 use Moose::Role;
+use Scalar::Util 'reftype';
 requires qw/_query_start/;
 
 use namespace::clean -except => 'meta';
@@ -30,11 +31,22 @@ Add C<DSN: > to debugging output.
 
 around '_query_start' => sub {
   my ($method, $self, $sql, @bind) = @_;
-  my $dsn = $self->_dbi_connect_info->[0];
+
+  my $dsn = eval { $self->dsn } || $self->_dbi_connect_info->[0];
+
   my($op, $rest) = (($sql=~m/^(\w+)(.+)$/),'NOP', 'NO SQL');
   my $storage_type = $self->can('active') ? 'REPLICANT' : 'MASTER';
 
-  $self->$method("$op [DSN_$storage_type=$dsn]$rest", @bind);
+  my $query = do {
+    if ((reftype($dsn)||'') ne 'CODE') {
+      "$op [DSN_$storage_type=$dsn]$rest";
+    }
+    else {
+      "$op [$storage_type]$rest";
+    }
+  };
+
+  $self->$method($query, @bind);
 };
 
 =head1 ALSO SEE