lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm

   1 package DBIx::Class::Storage::DBI::Replicated::Balancer;
   2
   3 use Moose::Role;
   4 requires 'next_storage';
   5 use MooseX::Types::Moose qw/Int/;
   6 use DBIx::Class::Storage::DBI::Replicated::Pool;
   7 use DBIx::Class::Storage::DBI::Replicated::Types qw/DBICStorageDBI/;
   8 use namespace::clean -except => 'meta';
   9
  10 =head1 NAME
  11
  12 DBIx::Class::Storage::DBI::Replicated::Balancer - A Software Load Balancer
  13
  14 =head1 SYNOPSIS
  15
  16 This role is used internally by L<DBIx::Class::Storage::DBI::Replicated>.
  17
  18 =head1 DESCRIPTION
  19
  20 Given a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>) of replicated
  21 database's (L<DBIx::Class::Storage::DBI::Replicated::Replicant>), defines a
  22 method by which query load can be spread out across each replicant in the pool.
  23
  24 =head1 ATTRIBUTES
  25
  26 This class defines the following attributes.
  27
  28 =head2 auto_validate_every ($seconds)
  29
  30 If auto_validate has some sort of value, run the L<validate_replicants> every
  31 $seconds.  Be careful with this, because if you set it to 0 you will end up
  32 validating every query.
  33
  34 =cut
  35
  36 has 'auto_validate_every' => (
  37   is=>'rw',
  38   isa=>Int,
  39   predicate=>'has_auto_validate_every',
  40 );
  41
  42 =head2 master
  43
  44 The L<DBIx::Class::Storage::DBI> object that is the master database all the
  45 replicants are trying to follow.  The balancer needs to know it since it's the
  46 ultimate fallback.
  47
  48 =cut
  49
  50 has 'master' => (
  51   is=>'ro',
  52   isa=>DBICStorageDBI,
  53   required=>1,
  54 );
  55
  56 =head2 pool
  57
  58 The L<DBIx::Class::Storage::DBI::Replicated::Pool> object that we are trying to
  59 balance.
  60
  61 =cut
  62
  63 has 'pool' => (
  64   is=>'ro',
  65   isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
  66   required=>1,
  67 );
  68
  69 =head2 current_replicant
  70
  71 Replicant storages (slaves) handle all read only traffic.  The assumption is
  72 that your database will become readbound well before it becomes write bound
  73 and that being able to spread your read only traffic around to multiple
  74 databases is going to help you to scale traffic.
  75
  76 This attribute returns the next slave to handle a read request.  Your L</pool>
  77 attribute has methods to help you shuffle through all the available replicants
  78 via its balancer object.
  79
  80 =cut
  81
  82 has 'current_replicant' => (
  83   is=> 'rw',
  84   isa=>DBICStorageDBI,
  85   lazy_build=>1,
  86   handles=>[qw/
  87     select
  88     select_single
  89     columns_info_for
  90   /],
  91 );
  92
  93 =head1 METHODS
  94
  95 This class defines the following methods.
  96
  97 =head2 _build_current_replicant
  98
  99 Lazy builder for the L</current_replicant_storage> attribute.
 100
 101 =cut
 102
 103 sub _build_current_replicant {
 104   my $self = shift @_;
 105   $self->next_storage;
 106 }
 107
 108 =head2 next_storage
 109
 110 This method should be defined in the class which consumes this role.
 111
 112 Given a pool object, return the next replicant that will serve queries.  The
 113 default behavior is to grab the first replicant it finds but you can write
 114 your own subclasses of L<DBIx::Class::Storage::DBI::Replicated::Balancer> to
 115 support other balance systems.
 116
 117 This returns from the pool of active replicants.  If there are no active
 118 replicants, then you should have it return the master as an ultimate fallback.
 119
 120 =head2 around: next_storage
 121
 122 Advice on next storage to add the autovalidation.  We have this broken out so
 123 that it's easier to break out the auto validation into a role.
 124
 125 This also returns the master in the case that none of the replicants are active
 126 or just just forgot to create them :)
 127
 128 =cut
 129
 130 my $on_master;
 131
 132 around 'next_storage' => sub {
 133   my ($next_storage, $self, @args) = @_;
 134   my $now = time;
 135
 136   ## Do we need to validate the replicants?
 137   if(
 138      $self->has_auto_validate_every &&
 139      ($self->auto_validate_every + $self->pool->last_validated) <= $now
 140   ) {
 141       $self->pool->validate_replicants;
 142   }
 143
 144   ## Get a replicant, or the master if none
 145   if(my $next = $self->$next_storage(@args)) {
 146     $self->master->debugobj->print("Moved back to slave\n") if $on_master;
 147     $on_master = 0;
 148     return $next;
 149   } else {
 150     $self->master->debugobj->print("No Replicants validate, falling back to master reads.\n")
 151        unless $on_master++;
 152
 153     return $self->master;
 154   }
 155 };
 156
 157 =head2 increment_storage
 158
 159 Rolls the Storage to whatever is next in the queue, as defined by the Balancer.
 160
 161 =cut
 162
 163 sub increment_storage {
 164   my $self = shift @_;
 165   my $next_replicant = $self->next_storage;
 166   $self->current_replicant($next_replicant);
 167 }
 168
 169 =head2 around: select
 170
 171 Advice on the select attribute.  Each time we use a replicant
 172 we need to change it via the storage pool algorithm.  That way we are spreading
 173 the load evenly (hopefully) across existing capacity.
 174
 175 =cut
 176
 177 around 'select' => sub {
 178   my ($select, $self, @args) = @_;
 179
 180   if (my $forced_pool = $args[-1]->{force_pool}) {
 181     delete $args[-1]->{force_pool};
 182     return $self->_get_forced_pool($forced_pool)->select(@args);
 183   } elsif($self->master->{transaction_depth}) {
 184     return $self->master->select(@args);
 185   } else {
 186     $self->increment_storage;
 187     return $self->$select(@args);
 188   }
 189 };
 190
 191 =head2 around: select_single
 192
 193 Advice on the select_single attribute.  Each time we use a replicant
 194 we need to change it via the storage pool algorithm.  That way we are spreading
 195 the load evenly (hopefully) across existing capacity.
 196
 197 =cut
 198
 199 around 'select_single' => sub {
 200   my ($select_single, $self, @args) = @_;
 201
 202   if (my $forced_pool = $args[-1]->{force_pool}) {
 203     delete $args[-1]->{force_pool};
 204     return $self->_get_forced_pool($forced_pool)->select_single(@args);
 205   } elsif($self->master->{transaction_depth}) {
 206     return $self->master->select_single(@args);
 207   } else {
 208     $self->increment_storage;
 209     return $self->$select_single(@args);
 210   }
 211 };
 212
 213 =head2 before: columns_info_for
 214
 215 Advice on the current_replicant_storage attribute.  Each time we use a replicant
 216 we need to change it via the storage pool algorithm.  That way we are spreading
 217 the load evenly (hopefully) across existing capacity.
 218
 219 =cut
 220
 221 before 'columns_info_for' => sub {
 222   my $self = shift @_;
 223   $self->increment_storage;
 224 };
 225
 226 =head2 _get_forced_pool ($name)
 227
 228 Given an identifier, find the most correct storage object to handle the query.
 229
 230 =cut
 231
 232 sub _get_forced_pool {
 233   my ($self, $forced_pool) = @_;
 234   if(blessed $forced_pool) {
 235     return $forced_pool;
 236   } elsif($forced_pool eq 'master') {
 237     return $self->master;
 238   } elsif(my $replicant = $self->pool->replicants->{$forced_pool}) {
 239     return $replicant;
 240   } else {
 241     $self->master->throw_exception("$forced_pool is not a named replicant.");
 242   }
 243 }
 244
 245 =head1 AUTHOR
 246
 247 John Napiorkowski <jjnapiork@cpan.org>
 248
 249 =head1 LICENSE
 250
 251 You may distribute this code under the same terms as Perl itself.
 252
 253 =cut
 254
 255 1;