From: Rafael Kitover <rkitover@cpan.org>
Date: Mon, 4 May 2009 21:07:43 +0000 (+0000)
Subject: ::Replicated - test hashref for connect_replicants and croak on coderef, switch to... 
X-Git-Tag: v0.08103~83^2~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9901aad73ff9dc45b426534fe406c102fb9fb77c;p=dbsrgits%2FDBIx-Class.git

::Replicated - test hashref for connect_replicants and croak on coderef, switch to MX::Types, make test less noisy
---

diff --git a/Makefile.PL b/Makefile.PL
index bd6963a..57b2be4 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -78,9 +78,9 @@ my %force_requires_if_author = (
 
   # t/93storage_replication.t
   'Moose',                        => 0.54,
-  'Moose::Util::TypeConstraints'  => 0.54,
   'MooseX::AttributeHelpers'      => 0.12,
-  'Class::MOP'                    => 0.63,
+  'MooseX::Types',                => 0.10,
+  'namespace::clean'              => 0.11,
 
   # t/96_is_deteministic_value.t
   'DateTime::Format::Strptime' => 0,
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 89979f1..59e74dc 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -7,10 +7,10 @@ BEGIN {
   ## use, so we explicitly test for these.
 	
   my %replication_required = (
-    Moose => '0.54',
+    Moose => '0.77',
     MooseX::AttributeHelpers => '0.12',
-    Moose::Util::TypeConstraints => '0.54',
-    Class::MOP => '0.63',
+    MooseX::Types => '0.10',
+    namespace::clean => '0.11',
   );
 	
   my @didnt_load;
@@ -28,6 +28,9 @@ BEGIN {
 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 namespace::clean -except => 'meta';
 
 =head1 NAME
 
@@ -99,10 +102,10 @@ to force a query to run against Master when needed.
 
 Replicated Storage has additional requirements not currently part of L<DBIx::Class>
 
-  Moose => 0.54
+  Moose => 0.77
   MooseX::AttributeHelpers => 0.12 
-  Moose::Util::TypeConstraints => 0.54
-  Class::MOP => 0.63
+  MooseX::Types => 0.10
+  namespace::clean => 0.11
   
 You will need to install these modules manually via CPAN or make them part of the
 Makefile for your distribution.
@@ -164,23 +167,9 @@ choose how to spread the query load across each replicant in the pool.
 
 =cut
 
-subtype 'DBIx::Class::Storage::DBI::Replicated::BalancerClassNamePart',
-  as 'ClassName';
-    
-coerce 'DBIx::Class::Storage::DBI::Replicated::BalancerClassNamePart',
-  from 'Str',
-  via {
-  	my $type = $_;
-    if($type=~m/^::/) {
-      $type = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$type;
-    }  
-    Class::MOP::load_class($type);  
-    $type;  	
-  };
-
 has 'balancer_type' => (
   is=>'ro',
-  isa=>'DBIx::Class::Storage::DBI::Replicated::BalancerClassNamePart',
+  isa=>BalancerClassNamePart,
   coerce=>1,
   required=>1,
   default=> 'DBIx::Class::Storage::DBI::Replicated::Balancer::First',
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index d862327..15be166 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -3,8 +3,11 @@ package DBIx::Class::Storage::DBI::Replicated::Pool;
 use Moose;
 use MooseX::AttributeHelpers;
 use DBIx::Class::Storage::DBI::Replicated::Replicant;
-use List::Util qw(sum);
-use Scalar::Util ();
+use List::Util 'sum';
+use Scalar::Util 'reftype';
+use Carp::Clan qw/^DBIx::Class/;
+
+use namespace::clean -except => 'meta';
 
 =head1 NAME
 
@@ -151,12 +154,15 @@ sub connect_replicants {
   my @newly_created = ();
   foreach my $connect_info (@_) {
     $connect_info = [ $connect_info ]
-      if Scalar::Util::reftype($connect_info) ne 'ARRAY';
+      if reftype $connect_info ne 'ARRAY';
+
+    croak "coderef 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 Scalar::Util::reftype($key) eq 'HASH';
+    $key = $key->{dsn} if ref $key && reftype $key eq 'HASH';
     ($key) = ($key =~ m/^dbi\:.+\:(.+)$/);
 
     $self->set_replicant( $key => $replicant);  
@@ -288,13 +294,13 @@ sub validate_replicants {
     if($self->_safely_ensure_connected($replicant)) {
       my $is_replicating = $replicant->is_replicating;
       unless(defined $is_replicating) {
-        $replicant->debugobj->print("Storage Driver ".ref $self." Does not support the 'is_replicating' method.  Assuming you are manually managing.");
+        $replicant->debugobj->print("Storage Driver ".ref($self)." Does not support the 'is_replicating' method.  Assuming you are manually managing.\n");
         next;
       } else {
         if($is_replicating) {
           my $lag_behind_master = $replicant->lag_behind_master;
           unless(defined $lag_behind_master) {
-            $replicant->debugobj->print("Storage Driver ".ref $self." Does not support the 'lag_behind_master' method.  Assuming you are manually managing.");
+            $replicant->debugobj->print("Storage Driver ".ref($self)." Does not support the 'lag_behind_master' method.  Assuming you are manually managing.\n");
             next;
           } else {
             if($lag_behind_master <= $self->maximum_lag) {
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
new file mode 100644
index 0000000..2595516
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
@@ -0,0 +1,23 @@
+package DBIx::Class::Storage::DBI::Replicated::Types;
+
+use MooseX::Types
+  -declare => [qw/BalancerClassNamePart/];
+use MooseX::Types::Moose qw/ClassName Str/;
+
+class_type 'DBIx::Class::Storage::DBI';
+
+subtype BalancerClassNamePart,
+  as ClassName;
+    
+coerce BalancerClassNamePart,
+  from Str,
+  via {
+    my $type = $_;
+    if($type=~m/^::/) {
+      $type = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$type;
+    }  
+    Class::MOP::load_class($type);  
+    $type;  	
+  };
+
+1;
diff --git a/lib/DBIx/Class/Storage/Statistics.pm b/lib/DBIx/Class/Storage/Statistics.pm
index b60c44e..c0a9853 100644
--- a/lib/DBIx/Class/Storage/Statistics.pm
+++ b/lib/DBIx/Class/Storage/Statistics.pm
@@ -5,7 +5,7 @@ use warnings;
 use base qw/Class::Accessor::Grouped/;
 use IO::File;
 
-__PACKAGE__->mk_group_accessors(simple => qw/callback debugfh/);
+__PACKAGE__->mk_group_accessors(simple => qw/callback debugfh silence/);
 
 =head1 NAME
 
@@ -56,6 +56,8 @@ to display the message.
 sub print {
   my ($self, $msg) = @_;
 
+  return if $self->silence;
+
   if(!defined($self->debugfh())) {
     my $fh;
     my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
diff --git a/t/93storage_replication.t b/t/93storage_replication.t
index b9ea61c..422a445 100644
--- a/t/93storage_replication.t
+++ b/t/93storage_replication.t
@@ -4,6 +4,7 @@ use lib qw(t/lib);
 use Test::More;
 use Test::Exception;
 use DBICTest;
+use List::Util 'first';
 
 BEGIN {
     eval "use DBIx::Class::Storage::DBI::Replicated; use Test::Moose";
@@ -124,9 +125,20 @@ TESTSCHEMACLASSES: {
             "dbi:SQLite:${_}";
         } @{$self->slave_paths};
         
-        return map { [$_,'','',{AutoCommit=>1}] } @dsn;
+        my @connect_infos = map { [$_,'','',{AutoCommit=>1}] } @dsn;
+
+    # try a hashref too
+        my $c = $connect_infos[0];
+        $connect_infos[0] = {
+          dsn => $c->[0],
+          user => $c->[1],
+          password => $c->[2],
+          %{ $c->[3] }
+        };
+
+        @connect_infos
     }
-    
+
     ## Do a 'good enough' replication by copying the master dbfile over each of
     ## the slave dbfiles.  If the master is SQLite we do this, otherwise we
     ## just do a one second pause to let the slaves catch up.
@@ -211,10 +223,19 @@ ok my @replicant_connects = $replicated->generate_replicant_connect_info
 
 ok my @replicated_storages = $replicated->schema->storage->connect_replicants(@replicant_connects)
     => 'Created some storages suitable for replicants';
-    
+ 
+my @replicant_names = keys %{ $replicated->schema->storage->replicants };
+
+## Silence warning about not supporting the is_replicating method if using the
+## sqlite dbs.
+$replicated->schema->storage->debugobj->silence(1)
+  if first { m{^t/} } @replicant_names;
+   
 isa_ok $replicated->schema->storage->balancer->current_replicant
-    => 'DBIx::Class::Storage::DBI';
-    
+    => 'DBIx::Class::Storage::DBI'; 
+
+$replicated->schema->storage->debugobj->silence(0);
+
 ok $replicated->schema->storage->pool->has_replicants
     => 'does have replicants';     
 
@@ -227,8 +248,6 @@ does_ok $replicated_storages[0]
 does_ok $replicated_storages[1]
     => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
     
-my @replicant_names = keys %{$replicated->schema->storage->replicants};
-
 does_ok $replicated->schema->storage->replicants->{$replicant_names[0]}
     => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
 
@@ -249,8 +268,16 @@ $replicated
 $replicated->replicate;
 $replicated->schema->storage->replicants->{$replicant_names[0]}->active(1);
 $replicated->schema->storage->replicants->{$replicant_names[1]}->active(1);
+
+## Silence warning about not supporting the is_replicating method if using the
+## sqlite dbs.
+$replicated->schema->storage->debugobj->silence(1)
+  if first { m{^t/} } @replicant_names;
+ 
 $replicated->schema->storage->pool->validate_replicants;
 
+$replicated->schema->storage->debugobj->silence(0);
+
 ## Make sure we can read the data.
 
 ok my $artist1 = $replicated->schema->resultset('Artist')->find(4)
@@ -350,14 +377,27 @@ ok $replicated->schema->resultset('Artist')->find(2)
 
 $replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
 $replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
-    
+
+## Silence warning about falling back to master.
+$replicated->schema->storage->debugobj->silence(1);
+ 
 ok $replicated->schema->resultset('Artist')->find(2)
     => 'Fallback to master';
 
+$replicated->schema->storage->debugobj->silence(0);
+
 $replicated->schema->storage->replicants->{$replicant_names[0]}->active(1);
 $replicated->schema->storage->replicants->{$replicant_names[1]}->active(1);
+
+## Silence warning about not supporting the is_replicating method if using the
+## sqlite dbs.
+$replicated->schema->storage->debugobj->silence(1)
+  if first { m{^t/} } @replicant_names;
+ 
 $replicated->schema->storage->pool->validate_replicants;
 
+$replicated->schema->storage->debugobj->silence(0);
+
 ok $replicated->schema->resultset('Artist')->find(2)
     => 'Returned to replicates';