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
  31 L<DBIx::Class::Storage::DBI::Replicated::Pool/validate_replicants>
  32 every $seconds.  Be careful with this, because if you set it to 0 you
  33 will end up validating every query.
  34
  35 =cut
  36
  37 has 'auto_validate_every' => (
  38   is=>'rw',
  39   isa=>Int,
  40   predicate=>'has_auto_validate_every',
  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=>'DBIx::Class::Storage::DBI::Replicated::Pool',
  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_build=>1,
  87   handles=>[qw/
  88     select
  89     select_single
  90     columns_info_for
  91   /],
  92 );
  93
  94 =head1 METHODS
  95
  96 This class defines the following methods.
  97
  98 =head2 _build_current_replicant
  99
 100 Lazy builder for the L</current_replicant_storage> attribute.
 101
 102 =cut
 103
 104 sub _build_current_replicant {
 105   my $self = shift @_;
 106   $self->next_storage;
 107 }
 108
 109 =head2 next_storage
 110
 111 This method should be defined in the class which consumes this role.
 112
 113 Given a pool object, return the next replicant that will serve queries.  The
 114 default behavior is to grab the first replicant it finds but you can write
 115 your own subclasses of L<DBIx::Class::Storage::DBI::Replicated::Balancer> to
 116 support other balance systems.
 117
 118 This returns from the pool of active replicants.  If there are no active
 119 replicants, then you should have it return the master as an ultimate fallback.
 120
 121 =head2 around: next_storage
 122
 123 Advice on next storage to add the autovalidation.  We have this broken out so
 124 that it's easier to break out the auto validation into a role.
 125
 126 This also returns the master in the case that none of the replicants are active
 127 or just just forgot to create them :)
 128
 129 =cut
 130
 131 my $on_master;
 132
 133 around 'next_storage' => sub {
 134   my ($next_storage, $self, @args) = @_;
 135   my $now = time;
 136
 137   ## Do we need to validate the replicants?
 138   if(
 139      $self->has_auto_validate_every &&
 140      ($self->auto_validate_every + $self->pool->last_validated) <= $now
 141   ) {
 142       $self->pool->validate_replicants;
 143   }
 144
 145   ## Get a replicant, or the master if none
 146   if(my $next = $self->$next_storage(@args)) {
 147     $self->master->debugobj->print("Moved back to slave\n") if $on_master;
 148     $on_master = 0;
 149     return $next;
 150   } else {
 151     $self->master->debugobj->print("No Replicants validate, falling back to master reads.\n")
 152        unless $on_master++;
 153
 154     return $self->master;
 155   }
 156 };
 157
 158 =head2 increment_storage
 159
 160 Rolls the Storage to whatever is next in the queue, as defined by the Balancer.
 161
 162 =cut
 163
 164 sub increment_storage {
 165   my $self = shift @_;
 166   my $next_replicant = $self->next_storage;
 167   $self->current_replicant($next_replicant);
 168 }
 169
 170 =head2 around: select
 171
 172 Advice on the select attribute.  Each time we use a replicant
 173 we need to change it via the storage pool algorithm.  That way we are spreading
 174 the load evenly (hopefully) across existing capacity.
 175
 176 =cut
 177
 178 around 'select' => sub {
 179   my ($select, $self, @args) = @_;
 180
 181   if (my $forced_pool = $args[-1]->{force_pool}) {
 182     delete $args[-1]->{force_pool};
 183     return $self->_get_forced_pool($forced_pool)->select(@args);
 184   } elsif($self->master->{transaction_depth}) {
 185     return $self->master->select(@args);
 186   } else {
 187     $self->increment_storage;
 188     return $self->$select(@args);
 189   }
 190 };
 191
 192 =head2 around: select_single
 193
 194 Advice on the select_single attribute.  Each time we use a replicant
 195 we need to change it via the storage pool algorithm.  That way we are spreading
 196 the load evenly (hopefully) across existing capacity.
 197
 198 =cut
 199
 200 around 'select_single' => sub {
 201   my ($select_single, $self, @args) = @_;
 202
 203   if (my $forced_pool = $args[-1]->{force_pool}) {
 204     delete $args[-1]->{force_pool};
 205     return $self->_get_forced_pool($forced_pool)->select_single(@args);
 206   } elsif($self->master->{transaction_depth}) {
 207     return $self->master->select_single(@args);
 208   } else {
 209     $self->increment_storage;
 210     return $self->$select_single(@args);
 211   }
 212 };
 213
 214 =head2 before: columns_info_for
 215
 216 Advice on the current_replicant_storage attribute.  Each time we use a replicant
 217 we need to change it via the storage pool algorithm.  That way we are spreading
 218 the load evenly (hopefully) across existing capacity.
 219
 220 =cut
 221
 222 before 'columns_info_for' => sub {
 223   my $self = shift @_;
 224   $self->increment_storage;
 225 };
 226
 227 =head2 _get_forced_pool ($name)
 228
 229 Given an identifier, find the most correct storage object to handle the query.
 230
 231 =cut
 232
 233 sub _get_forced_pool {
 234   my ($self, $forced_pool) = @_;
 235   if(blessed $forced_pool) {
 236     return $forced_pool;
 237   } elsif($forced_pool eq 'master') {
 238     return $self->master;
 239   } elsif(my $replicant = $self->pool->replicants->{$forced_pool}) {
 240     return $replicant;
 241   } else {
 242     $self->master->throw_exception("$forced_pool is not a named replicant.");
 243   }
 244 }
 245
 246 =head1 AUTHOR
 247
 248 John Napiorkowski <jjnapiork@cpan.org>
 249
 250 =head1 LICENSE
 251
 252 You may distribute this code under the same terms as Perl itself.
 253
 254 =cut
 255
 256 1;