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