good start on the validation of replicants and a system to automatically validate...

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 4514e08..7323b42 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -118,6 +118,7 @@ has 'pool' => (
         has_replicants
         num_replicants
         delete_replicant
+        validate_replicants
     /],
 );
 

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
index 7ca7cff..f69ce8c 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
@@ -21,6 +21,39 @@ method by which query load can be spread out across each replicant in the pool.
 
 This class defines the following attributes.
 
+=head2 auto_validate_every ($seconds)
+
+If auto_validate has some sort of value, run the L<validate_replicants> every
+$seconds.  Be careful with this, because if you set it to 0 you will end up
+validating every query.
+
+=cut
+
+has 'auto_validate_every' => (
+    is=>'rw',
+    isa=>'Int',
+    predicate=>'had_auto_validate_every',
+);
+
+=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 
+builtin.
+
+=cut
+
+has 'last_validated' => (
+    is=>'rw',
+    isa=>'Int',
+    reader=>'last_validated',
+    writer=>'_last_validated',
+    lazy=>1,
+    default=>sub {
+       time;
+    },
+);
+
 =head2 master
 
 The L<DBIx::Class::Storage::DBI> object that is the master database all the
@@ -97,10 +130,23 @@ support other balance systems.
 This returns from the pool of active replicants.  If there are no active
 replicants, then you should have it return the master as an ultimate fallback.
 
+TODO this needs to wrap for the subclasses better. Maybe good use of INNER?
+
 =cut
 
 sub next_storage {
        my $self = shift @_;
+       
+       ## Do we need to validate the replicants?
+       if(
+          $self->had_auto_validate_every && 
+          ($self->auto_validate_every + $self->last_validated) > time
+       ) {
+               $self->pool->validate_replicants;
+               $self->_last_validated(time);
+       }
+       
+       ## Get a replicant, or the master if none
        my $next = ($self->pool->active_replicants)[0];
        return $next ? $next:$self->master;
 }

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index 8f0d66d..4f406c3 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -36,7 +36,7 @@ return a number of seconds that the replicating database is lagging.
 =cut
 
 has 'maximum_lag' => (
-    is=>'ro',
+    is=>'rw',
     isa=>'Num',
     required=>1,
     lazy=>1,
@@ -192,8 +192,8 @@ array is given, nor should any meaning be derived.
 =cut
 
 sub all_replicants {
-       my $self = shift @_;
-       return values %{$self->replicants};
+    my $self = shift @_;
+    return values %{$self->replicants};
 }
 
 =head2 validate_replicants
@@ -215,10 +215,20 @@ not recommended that you run them very often.
 =cut
 
 sub validate_replicants {
-       my $self = shift @_;
-       foreach my $replicant($self->all_replicants) {
-               
-       }
+    my $self = shift @_;
+    foreach my $replicant($self->all_replicants) {
+        if(
+            $replicant->is_replicating &&
+            $replicant->lag_behind_master <= $self->maximum_lag &&
+            $replicant->ensure_connected
+        ) {
+               ## TODO:: Hook debug for this
+            $replicant->active(1)
+        } else {
+               ## TODO:: Hook debug for this
+            $replicant->active(0);
+        }
+    }
 }
 
 =head1 AUTHOR

diff --git a/t/93storage_replication.t b/t/93storage_replication.t
index a4b377e..20739da 100644 (file)
--- a/t/93storage_replication.t
+++ b/t/93storage_replication.t
@@ -8,7 +8,7 @@ BEGIN {
     eval "use Moose; use Test::Moose";
     plan $@
         ? ( skip_all => 'needs Moose for testing' )
-        : ( tests => 43 );
+        : ( tests => 46 );
 }
 
 use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
@@ -369,7 +369,7 @@ SKIP: {
     ## We skip this tests unless you have a custom replicants, since the default
     ## sqlite based replication tests don't support these functions.
     
-    skip 'Cannot Test Replicant Status on Non Replicating Database', 2
+    skip 'Cannot Test Replicant Status on Non Replicating Database', 3
      unless DBICTest->has_custom_dsn && $ENV{"DBICTEST_SLAVE0_DSN"};
 
     $replicated->replicate; ## Give the slaves a chance to catchup.
@@ -379,6 +379,30 @@ SKIP: {
            
        is $replicated->schema->storage->replicants->{$replicant_names[0]}->lag_behind_master, 0
            => 'Replicant is zero seconds behind master';
+           
+       ## Test the validate replicants
+       
+       $replicated->schema->storage->pool->validate_replicants;
+       
+       is $replicated->schema->storage->pool->active_replicants, 2
+           => 'Still have 2 replicants after validation';
+           
+       ## Force the replicants to fail the validate test by required their lag to
+       ## be negative (ie ahead of the master!)
+       
+    $replicated->schema->storage->pool->maximum_lag(-10);
+    $replicated->schema->storage->pool->validate_replicants;
+    
+    is $replicated->schema->storage->pool->active_replicants, 0
+        => 'No way a replicant be be ahead of the master';
+        
+    ## Let's be fair to the replicants again.  Let them lag up to 5
+       
+    $replicated->schema->storage->pool->maximum_lag(5);
+    $replicated->schema->storage->pool->validate_replicants;
+    
+    is $replicated->schema->storage->pool->active_replicants, 2
+        => 'Both replicants in good standing again';   
 }
 
 ## Delete the old database files