a few more Moose Type related fixes and added diag to the replication test to report...
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Replicated / Balancer.pm
index 7ca7cff..d7a8769 100644 (file)
@@ -1,15 +1,19 @@
 package DBIx::Class::Storage::DBI::Replicated::Balancer;
 
-use Moose;
+use Moose::Role;
+requires 'next_storage';
+use MooseX::Types::Moose qw/Int/;
+use DBIx::Class::Storage::DBI::Replicated::Pool;
+use DBIx::Class::Storage::DBI::Replicated::Types qw/DBICStorageDBI/;
+use namespace::clean -except => 'meta';
 
 =head1 NAME
 
-DBIx::Class::Storage::DBI::Replicated::Balancer; A Software Load Balancer 
+DBIx::Class::Storage::DBI::Replicated::Balancer - A Software Load Balancer 
 
 =head1 SYNOPSIS
 
-This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.  You
-shouldn't need to create instances of this class.
+This role is used internally by L<DBIx::Class::Storage::DBI::Replicated>.
     
 =head1 DESCRIPTION
 
@@ -21,6 +25,20 @@ 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=>'has_auto_validate_every',
+);
+
 =head2 master
 
 The L<DBIx::Class::Storage::DBI> object that is the master database all the
@@ -30,9 +48,9 @@ ultimate fallback.
 =cut
 
 has 'master' => (
-    is=>'ro',
-    isa=>'DBIx::Class::Storage::DBI',
-    required=>1,
+  is=>'ro',
+  isa=>DBICStorageDBI,
+  required=>1,
 );
 
 =head2 pool
@@ -43,9 +61,9 @@ balance.
 =cut
 
 has 'pool' => (
-    is=>'ro',
-    isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
-    required=>1,
+  is=>'ro',
+  isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
+  required=>1,
 );
 
 =head2 current_replicant
@@ -62,14 +80,14 @@ via it's balancer object.
 =cut
 
 has 'current_replicant' => (
-    is=> 'rw',
-    isa=>'DBIx::Class::Storage::DBI',
-    lazy_build=>1,
-    handles=>[qw/
-        select
-        select_single
-        columns_info_for
-    /],
+  is=> 'rw',
+  isa=>DBICStorageDBI,
+  lazy_build=>1,
+  handles=>[qw/
+    select
+    select_single
+    columns_info_for
+  /],
 );
 
 =head1 METHODS
@@ -83,12 +101,14 @@ Lazy builder for the L</current_replicant_storage> attribute.
 =cut
 
 sub _build_current_replicant {
-    my $self = shift @_;
-    $self->next_storage;
+  my $self = shift @_;
+  $self->next_storage;
 }
 
 =head2 next_storage
 
+This method should be defined in the class which consumes this role.
+
 Given a pool object, return the next replicant that will serve queries.  The
 default behavior is to grap the first replicant it finds but you can write 
 your own subclasses of L<DBIx::Class::Storage::DBI::Replicated::Balancer> to 
@@ -97,15 +117,50 @@ 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.
 
+=head2 around: next_storage
+
+Advice on next storage to add the autovalidation.  We have this broken out so
+that it's easier to break out the auto validation into a role.
+
+This also returns the master in the case that none of the replicants are active
+or just just forgot to create them :)
+
+=cut
+
+around 'next_storage' => sub {
+  my ($next_storage, $self, @args) = @_;
+  my $now = time;
+
+  ## Do we need to validate the replicants?
+  if(
+     $self->has_auto_validate_every && 
+     ($self->auto_validate_every + $self->pool->last_validated) <= $now
+  ) {   
+      $self->pool->validate_replicants;
+  }
+
+  ## Get a replicant, or the master if none
+  if(my $next = $self->$next_storage(@args)) {
+    return $next;
+  } else {
+    $self->master->debugobj->print("No Replicants validate, falling back to master reads. ");
+    return $self->master;
+  }
+};
+
+=head2 increment_storage
+
+Rolls the Storage to whatever is next in the queue, as defined by the Balancer.
+
 =cut
 
-sub next_storage {
-       my $self = shift @_;
-       my $next = ($self->pool->active_replicants)[0];
-       return $next ? $next:$self->master;
+sub increment_storage {
+  my $self = shift @_;
+  my $next_replicant = $self->next_storage;
+  $self->current_replicant($next_replicant);
 }
 
-=head2 before: select
+=head2 around: select
 
 Advice on the select attribute.  Each time we use a replicant
 we need to change it via the storage pool algorithm.  That way we are spreading
@@ -113,13 +168,21 @@ the load evenly (hopefully) across existing capacity.
 
 =cut
 
-before 'select' => sub {
-    my $self = shift @_;
-    my $next_replicant = $self->next_storage;
-    $self->current_replicant($next_replicant);
+around 'select' => sub {
+  my ($select, $self, @args) = @_;
+
+  if (my $forced_pool = $args[-1]->{force_pool}) {
+    delete $args[-1]->{force_pool};
+    return $self->_get_forced_pool($forced_pool)->select(@args); 
+  } elsif($self->master->{transaction_depth}) {
+    return $self->master->select(@args);
+  } else {
+    $self->increment_storage;
+    return $self->$select(@args);
+  }
 };
 
-=head2 before: select_single
+=head2 around: select_single
 
 Advice on the select_single attribute.  Each time we use a replicant
 we need to change it via the storage pool algorithm.  That way we are spreading
@@ -127,10 +190,18 @@ the load evenly (hopefully) across existing capacity.
 
 =cut
 
-before 'select_single' => sub {
-    my $self = shift @_;
-    my $next_replicant = $self->next_storage;
-    $self->current_replicant($next_replicant);
+around 'select_single' => sub {
+  my ($select_single, $self, @args) = @_;
+
+  if (my $forced_pool = $args[-1]->{force_pool}) {
+    delete $args[-1]->{force_pool};
+    return $self->_get_forced_pool($forced_pool)->select_single(@args); 
+  } elsif($self->master->{transaction_depth}) {
+    return $self->master->select_single(@args);
+  } else {
+    $self->increment_storage;
+    return $self->$select_single(@args);
+  }
 };
 
 =head2 before: columns_info_for
@@ -142,14 +213,32 @@ the load evenly (hopefully) across existing capacity.
 =cut
 
 before 'columns_info_for' => sub {
-    my $self = shift @_;
-    my $next_replicant = $self->next_storage;
-    $self->current_replicant($next_replicant);
+  my $self = shift @_;
+  $self->increment_storage;
 };
 
+=head2 _get_forced_pool ($name)
+
+Given an identifier, find the most correct storage object to handle the query.
+
+=cut
+
+sub _get_forced_pool {
+  my ($self, $forced_pool) = @_;
+  if(blessed $forced_pool) {
+    return $forced_pool;
+  } elsif($forced_pool eq 'master') {
+    return $self->master;
+  } elsif(my $replicant = $self->pool->replicants->{$forced_pool}) {
+    return $replicant;
+  } else {
+    $self->master->throw_exception("$forced_pool is not a named replicant.");
+  }   
+}
+
 =head1 AUTHOR
 
-John Napiorkowski <john.napiorkowski@takkle.com>
+John Napiorkowski <jjnapiork@cpan.org>
 
 =head1 LICENSE