Merge 'trunk' into 'sqla_1.50_compat'
[dbsrgits/DBIx-Class-Historic.git] / 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   if(my $next = $self->$next_storage(@args)) {
140     return $next;
141   } else {
142     $self->master->debugobj->print("No Replicants validate, falling back to master reads. ");
143     return $self->master;
144   }
145 };
146
147 =head2 increment_storage
148
149 Rolls the Storage to whatever is next in the queue, as defined by the Balancer.
150
151 =cut
152
153 sub increment_storage {
154   my $self = shift @_;
155   my $next_replicant = $self->next_storage;
156   $self->current_replicant($next_replicant);
157 }
158
159 =head2 around: select
160
161 Advice on the select attribute.  Each time we use a replicant
162 we need to change it via the storage pool algorithm.  That way we are spreading
163 the load evenly (hopefully) across existing capacity.
164
165 =cut
166
167 around 'select' => sub {
168   my ($select, $self, @args) = @_;
169   
170   if (my $forced_pool = $args[-1]->{force_pool}) {
171     delete $args[-1]->{force_pool};
172     return $self->_get_forced_pool($forced_pool)->select(@args); 
173   } else {
174     $self->increment_storage;
175     return $self->$select(@args);
176   }
177 };
178
179 =head2 around: select_single
180
181 Advice on the select_single attribute.  Each time we use a replicant
182 we need to change it via the storage pool algorithm.  That way we are spreading
183 the load evenly (hopefully) across existing capacity.
184
185 =cut
186
187 around 'select_single' => sub {
188   my ($select_single, $self, @args) = @_;
189   
190   if (my $forced_pool = $args[-1]->{force_pool}) {
191     delete $args[-1]->{force_pool};
192     return $self->_get_forced_pool($forced_pool)->select_single(@args); 
193   } else {
194     $self->increment_storage;
195     return $self->$select_single(@args);
196   }
197 };
198
199 =head2 before: columns_info_for
200
201 Advice on the current_replicant_storage attribute.  Each time we use a replicant
202 we need to change it via the storage pool algorithm.  That way we are spreading
203 the load evenly (hopefully) across existing capacity.
204
205 =cut
206
207 before 'columns_info_for' => sub {
208   my $self = shift @_;
209   $self->increment_storage;
210 };
211
212 =head2 _get_forced_pool ($name)
213
214 Given an identifier, find the most correct storage object to handle the query.
215
216 =cut
217
218 sub _get_forced_pool {
219   my ($self, $forced_pool) = @_;
220   if(blessed $forced_pool) {
221     return $forced_pool;
222   } elsif($forced_pool eq 'master') {
223     return $self->master;
224   } elsif(my $replicant = $self->pool->replicants($forced_pool)) {
225     return $replicant;
226   } else {
227     $self->master->throw_exception("$forced_pool is not a named replicant.");
228   }   
229 }
230
231 =head1 AUTHOR
232
233 John Napiorkowski <john.napiorkowski@takkle.com>
234
235 =head1 LICENSE
236
237 You may distribute this code under the same terms as Perl itself.
238
239 =cut
240
241 1;