X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FReplicated%2FBalancer.pm;h=7b579726157234f024f96bc9017c9564f8bdee9f;hb=f92a9d790b900dcb183ff62b4e2e770a53f01ac6;hp=186e4832d24d6f687c971f00329420a1a9652e22;hpb=bbafcf262b74716a37f4265512ba5c1ecd92e15b;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
index 186e483..7b57972 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
@@ -2,15 +2,19 @@ package DBIx::Class::Storage::DBI::Replicated::Balancer;
 
 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 role is used internally by L<DBIx::Class::Storage::DBI::Replicated>.
-    
+
 =head1 DESCRIPTION
 
 Given a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>) of replicated
@@ -23,15 +27,16 @@ 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.
+If auto_validate has some sort of value, run
+L<DBIx::Class::Storage::DBI::Replicated::Pool/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',
+  isa=>Int,
   predicate=>'has_auto_validate_every',
 );
 
@@ -45,7 +50,7 @@ ultimate fallback.
 
 has 'master' => (
   is=>'ro',
-  isa=>'DBIx::Class::Storage::DBI',
+  isa=>DBICStorageDBI,
   required=>1,
 );
 
@@ -71,13 +76,13 @@ databases is going to help you to scale traffic.
 
 This attribute returns the next slave to handle a read request.  Your L</pool>
 attribute has methods to help you shuffle through all the available replicants
-via it's balancer object.
+via its balancer object.
 
 =cut
 
 has 'current_replicant' => (
   is=> 'rw',
-  isa=>'DBIx::Class::Storage::DBI',
+  isa=>DBICStorageDBI,
   lazy_build=>1,
   handles=>[qw/
     select
@@ -106,7 +111,7 @@ sub _build_current_replicant {
 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 
+default behavior is to grab the first replicant it finds but you can write 
 your own subclasses of L<DBIx::Class::Storage::DBI::Replicated::Balancer> to 
 support other balance systems.
 
@@ -123,21 +128,31 @@ or just just forgot to create them :)
 
 =cut
 
+my $on_master;
+
 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
-  my $next = $self->$next_storage(@args);
-  return $next ? $next:$self->master; 
+  if(my $next = $self->$next_storage(@args)) {
+    $self->master->debugobj->print("Moved back to slave\n") if $on_master;
+    $on_master = 0;
+    return $next;
+  } else {
+    $self->master->debugobj->print("No Replicants validate, falling back to master reads.\n")
+       unless $on_master++;
+
+    return $self->master;
+  }
 };
 
 =head2 increment_storage
@@ -162,8 +177,11 @@ the load evenly (hopefully) across existing capacity.
 
 around 'select' => sub {
   my ($select, $self, @args) = @_;
-  
-  if ($args[-1]->{execute_reliably}) {
+
+  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;
@@ -181,11 +199,14 @@ the load evenly (hopefully) across existing capacity.
 
 around 'select_single' => sub {
   my ($select_single, $self, @args) = @_;
-  
-  if ($args[-1]->{execute_reliably}) {
+
+  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;
+    $self->increment_storage;
     return $self->$select_single(@args);
   }
 };
@@ -203,9 +224,28 @@ before 'columns_info_for' => sub {
   $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