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