From: Rafael Kitover <rkitover@cpan.org>
Date: Wed, 6 May 2009 13:29:39 +0000 (+0000)
Subject: ::DBI:Replicated - merge connect_info from master to replicants
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b2e4d52289df8386abc4b79ee68c31f9798a1181;p=dbsrgits%2FDBIx-Class-Historic.git

::DBI:Replicated - merge connect_info from master to replicants
---

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index a241ff4..549bc76 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -25,11 +25,14 @@ BEGIN {
     if @didnt_load;  	
 }
 
+use Moose;
 use DBIx::Class::Storage::DBI;
 use DBIx::Class::Storage::DBI::Replicated::Pool;
 use DBIx::Class::Storage::DBI::Replicated::Balancer;
 use DBIx::Class::Storage::DBI::Replicated::Types 'BalancerClassNamePart';
 use MooseX::Types::Moose qw/ClassName HashRef Object/;
+use Scalar::Util 'reftype';
+use Carp::Clan qw/^DBIx::Class/;
 
 use namespace::clean -except => 'meta';
 
@@ -307,6 +310,31 @@ has 'write_handler' => (
   /],
 );
 
+has _master_connect_info_opts =>
+  (is => 'rw', isa => HashRef, default => sub { {} });
+
+=head2 around: connect_info
+
+Preserve master's C<connect_info> options (for merging with replicants.)
+
+=cut
+
+around connect_info => sub {
+  my ($next, $self, $info, @extra) = @_;
+
+  my %opts;
+  for my $arg (@$info) {
+    next unless (reftype($arg)||'') eq 'HASH';
+    %opts = (%opts, %$arg);
+  }
+
+  delete $opts{dsn};
+
+  $self->_master_connect_info_opts(\%opts);
+
+  $self->$next($info, @extra);
+};
+
 =head1 METHODS
 
 This class defines the following methods.
@@ -392,13 +420,39 @@ sub _build_read_handler {
 =head2 around: connect_replicants
 
 All calls to connect_replicants needs to have an existing $schema tacked onto
-top of the args, since L<DBIx::Storage::DBI> needs it.
+top of the args, since L<DBIx::Storage::DBI> needs it, and any C<connect_info>
+options merged with the master, with replicant opts having higher priority.
 
 =cut
 
-around 'connect_replicants' => sub {
-  my ($method, $self, @args) = @_;
-  $self->$method($self->schema, @args);
+around connect_replicants => sub {
+  my ($next, $self, @args) = @_;
+
+  for my $r (@args) {
+    $r = [ $r ] unless reftype $r eq 'ARRAY';
+
+    croak "coderef replicant connect_info not supported"
+      if ref $r->[0] && reftype $r->[0] eq 'CODE';
+
+# any connect_info options?
+    my $i = 0;
+    $i++ while $i < @$r && (reftype($r->[$i])||'') ne 'HASH';
+
+# make one if none    
+    $r->[$i] = {} unless $r->[$i];
+
+# merge if two hashes
+    my %opts = map %$_, @$r[$i .. $#{$r}];
+    splice @$r, $i+1, ($#{$r} - $i), ();
+
+# merge with master
+    %opts = (%{ $self->_master_connect_info_opts }, %opts);
+
+# update
+    $r->[$i] = \%opts;
+  }
+
+  $self->$next($self->schema, @args);
 };
 
 =head2 all_storages
@@ -683,6 +737,21 @@ sub disconnect {
   }
 }
 
+=head2 cursor_class
+
+set cursor class on all storages, or return master's
+
+=cut
+
+sub cursor_class {
+  my ($self, $cursor_class) = @_;
+
+  if ($cursor_class) {
+    $_->cursor_class($cursor_class) for $self->all_storages;
+  }
+  $self->master->cursor_class;
+}
+  
 =head1 GOTCHAS
 
 Due to the fact that replicants can lag behind a master, you must take care to
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index aa3d7fc..1b50a70 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -157,7 +157,7 @@ sub connect_replicants {
     $connect_info = [ $connect_info ]
       if reftype $connect_info ne 'ARRAY';
 
-    croak "coderef connect_info not supported"
+    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);
diff --git a/t/93storage_replication.t b/t/93storage_replication.t
index f6d2be6..0f4b352 100644
--- a/t/93storage_replication.t
+++ b/t/93storage_replication.t
@@ -5,12 +5,13 @@ use Test::More;
 use Test::Exception;
 use DBICTest;
 use List::Util 'first';
+use Scalar::Util 'reftype';
 
 BEGIN {
     eval "use DBIx::Class::Storage::DBI::Replicated; use Test::Moose";
     plan $@
         ? ( skip_all => "Deps not installed: $@" )
-        : ( tests => 82 );
+        : ( tests => 83 );
 }
 
 use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
@@ -87,6 +88,26 @@ TESTSCHEMACLASSES: {
     sub replicate {}
     sub cleanup {}
 
+    ## --------------------------------------------------------------------- ##
+    ## Add a connect_info option to test option merging.
+    ## --------------------------------------------------------------------- ##
+    {
+    package DBIx::Class::Storage::DBI::Replicated;
+
+    use Moose;
+
+    __PACKAGE__->meta->make_mutable;
+
+    around connect_info => sub {
+      my ($next, $self, $info) = @_;
+      $info->[3]{master_option} = 1;
+      $self->$next($info);
+    };
+
+    __PACKAGE__->meta->make_immutable;
+
+    no Moose;
+    }
   
     ## --------------------------------------------------------------------- ##
     ## Subclass for when you are using SQLite for testing, this provides a fake
@@ -227,11 +248,19 @@ ok my @replicated_storages = $replicated->schema->storage->connect_replicants(@r
 ok my @all_storages = $replicated->schema->storage->all_storages
     => '->all_storages';
 
-ok @all_storages == 3
+is scalar @all_storages
+    ,3
     => 'correct number of ->all_storages';
 
-ok ((grep $_->isa('DBIx::Class::Storage::DBI'), @all_storages) == 3
+is ((grep $_->isa('DBIx::Class::Storage::DBI'), @all_storages)
+    ,3
     => '->all_storages are correct type');
+
+is ((grep $_->{master_option},
+      grep { (reftype($_)||'') eq 'HASH' }
+        map @{ $_->_connect_info }, @all_storages)
+    ,3
+    => 'connect_info was merged from master to replicants');
  
 my @replicant_names = keys %{ $replicated->schema->storage->replicants };