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

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