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