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