Commit | Line | Data |
26ab719a |
1 | package DBIx::Class::Storage::DBI::Replicated::Pool; |
2 | |
3 | use Moose; |
4 | use MooseX::AttributeHelpers; |
5 | use DBIx::Class::Storage::DBI::Replicated::Replicant; |
9901aad7 |
6 | use List::Util 'sum'; |
7 | use Scalar::Util 'reftype'; |
0bd8e058 |
8 | use DBI (); |
9901aad7 |
9 | use Carp::Clan qw/^DBIx::Class/; |
41916570 |
10 | use MooseX::Types::Moose qw/Num Int ClassName HashRef/; |
9901aad7 |
11 | |
12 | use namespace::clean -except => 'meta'; |
26ab719a |
13 | |
14 | =head1 NAME |
15 | |
21fc4719 |
16 | DBIx::Class::Storage::DBI::Replicated::Pool - Manage a pool of replicants |
26ab719a |
17 | |
18 | =head1 SYNOPSIS |
19 | |
20 | This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>. You |
21 | shouldn't need to create instances of this class. |
d4daee7b |
22 | |
26ab719a |
23 | =head1 DESCRIPTION |
24 | |
25 | In a replicated storage type, there is at least one replicant to handle the |
26 | read only traffic. The Pool class manages this replicant, or list of |
27 | replicants, and gives some methods for querying information about their status. |
28 | |
29 | =head1 ATTRIBUTES |
30 | |
31 | This class defines the following attributes. |
32 | |
4a607d7a |
33 | =head2 maximum_lag ($num) |
34 | |
35 | This is a number which defines the maximum allowed lag returned by the |
36 | L<DBIx::Class::Storage::DBI/lag_behind_master> method. The default is 0. In |
37 | general, this should return a larger number when the replicant is lagging |
faaba25f |
38 | behind its master, however the implementation of this is database specific, so |
4a607d7a |
39 | don't count on this number having a fixed meaning. For example, MySQL will |
40 | return a number of seconds that the replicating database is lagging. |
41 | |
42 | =cut |
43 | |
44 | has 'maximum_lag' => ( |
64cdad22 |
45 | is=>'rw', |
41916570 |
46 | isa=>Num, |
64cdad22 |
47 | required=>1, |
48 | lazy=>1, |
49 | default=>0, |
4a607d7a |
50 | ); |
51 | |
17b05c13 |
52 | =head2 last_validated |
53 | |
54 | This is an integer representing a time since the last time the replicants were |
faaba25f |
55 | validated. It's nothing fancy, just an integer provided via the perl L<time|perlfunc/time> |
17b05c13 |
56 | builtin. |
57 | |
58 | =cut |
59 | |
60 | has 'last_validated' => ( |
64cdad22 |
61 | is=>'rw', |
41916570 |
62 | isa=>Int, |
64cdad22 |
63 | reader=>'last_validated', |
64 | writer=>'_last_validated', |
65 | lazy=>1, |
66 | default=>0, |
17b05c13 |
67 | ); |
68 | |
4a607d7a |
69 | =head2 replicant_type ($classname) |
26ab719a |
70 | |
71 | Base class used to instantiate replicants that are in the pool. Unless you |
72 | need to subclass L<DBIx::Class::Storage::DBI::Replicated::Replicant> you should |
73 | just leave this alone. |
74 | |
75 | =cut |
76 | |
77 | has 'replicant_type' => ( |
64cdad22 |
78 | is=>'ro', |
41916570 |
79 | isa=>ClassName, |
64cdad22 |
80 | required=>1, |
81 | default=>'DBIx::Class::Storage::DBI', |
82 | handles=>{ |
83 | 'create_replicant' => 'new', |
84 | }, |
26ab719a |
85 | ); |
86 | |
26ab719a |
87 | =head2 replicants |
88 | |
89 | A hashref of replicant, with the key being the dsn and the value returning the |
90 | actual replicant storage. For example if the $dsn element is something like: |
91 | |
64cdad22 |
92 | "dbi:SQLite:dbname=dbfile" |
d4daee7b |
93 | |
26ab719a |
94 | You could access the specific replicant via: |
95 | |
64cdad22 |
96 | $schema->storage->replicants->{'dbname=dbfile'} |
d4daee7b |
97 | |
64cdad22 |
98 | This attributes also supports the following helper methods: |
26ab719a |
99 | |
100 | =over 4 |
101 | |
102 | =item set_replicant($key=>$storage) |
103 | |
104 | Pushes a replicant onto the HashRef under $key |
105 | |
106 | =item get_replicant($key) |
107 | |
108 | Retrieves the named replicant |
109 | |
110 | =item has_replicants |
111 | |
112 | Returns true if the Pool defines replicants. |
113 | |
114 | =item num_replicants |
115 | |
116 | The number of replicants in the pool |
117 | |
118 | =item delete_replicant ($key) |
119 | |
120 | removes the replicant under $key from the pool |
121 | |
122 | =back |
123 | |
124 | =cut |
125 | |
126 | has 'replicants' => ( |
64cdad22 |
127 | is=>'rw', |
128 | metaclass => 'Collection::Hash', |
071bbccb |
129 | isa=>HashRef['Object'], |
64cdad22 |
130 | default=>sub {{}}, |
131 | provides => { |
132 | 'set' => 'set_replicant', |
d4daee7b |
133 | 'get' => 'get_replicant', |
64cdad22 |
134 | 'empty' => 'has_replicants', |
135 | 'count' => 'num_replicants', |
136 | 'delete' => 'delete_replicant', |
d4daee7b |
137 | 'values' => 'all_replicant_storages', |
64cdad22 |
138 | }, |
26ab719a |
139 | ); |
140 | |
26ab719a |
141 | =head1 METHODS |
142 | |
143 | This class defines the following methods. |
144 | |
955a6df6 |
145 | =head2 connect_replicants ($schema, Array[$connect_info]) |
26ab719a |
146 | |
d40080c3 |
147 | Given an array of $dsn or connect_info structures suitable for connected to a |
148 | database, create an L<DBIx::Class::Storage::DBI::Replicated::Replicant> object |
149 | and store it in the L</replicants> attribute. |
26ab719a |
150 | |
151 | =cut |
152 | |
955a6df6 |
153 | sub connect_replicants { |
64cdad22 |
154 | my $self = shift @_; |
155 | my $schema = shift @_; |
d4daee7b |
156 | |
64cdad22 |
157 | my @newly_created = (); |
158 | foreach my $connect_info (@_) { |
2cd3ccc4 |
159 | $connect_info = [ $connect_info ] |
9901aad7 |
160 | if reftype $connect_info ne 'ARRAY'; |
161 | |
0bd8e058 |
162 | my $connect_coderef = |
163 | (reftype($connect_info->[0])||'') eq 'CODE' ? $connect_info->[0] |
164 | : (reftype($connect_info->[0])||'') eq 'HASH' && |
165 | $connect_info->[0]->{dbh_maker}; |
166 | |
167 | my $dsn; |
4c91f824 |
168 | my $replicant = do { |
0bd8e058 |
169 | # yes this is evil, but it only usually happens once |
170 | no warnings 'redefine'; |
171 | my $connect = \&DBI::connect; |
172 | local *DBI::connect = sub { |
173 | $dsn = $_[1]; |
174 | goto $connect; |
175 | }; |
4c91f824 |
176 | $self->connect_replicant($schema, $connect_info); |
177 | }; |
178 | |
179 | if (!$dsn && !$connect_coderef) { |
180 | $dsn = $connect_info->[0]; |
181 | $dsn = $dsn->{dsn} if (reftype($dsn)||'') eq 'HASH'; |
0bd8e058 |
182 | } |
183 | $replicant->dsn($dsn); |
4c91f824 |
184 | |
0bd8e058 |
185 | my ($key) = ($dsn =~ m/^dbi\:.+\:(.+)$/i); |
186 | |
187 | $self->set_replicant($key => $replicant); |
64cdad22 |
188 | push @newly_created, $replicant; |
189 | } |
d4daee7b |
190 | |
64cdad22 |
191 | return @newly_created; |
26ab719a |
192 | } |
193 | |
bbafcf26 |
194 | =head2 connect_replicant ($schema, $connect_info) |
195 | |
196 | Given a schema object and a hashref of $connect_info, connect the replicant |
197 | and return it. |
198 | |
199 | =cut |
200 | |
201 | sub connect_replicant { |
202 | my ($self, $schema, $connect_info) = @_; |
203 | my $replicant = $self->create_replicant($schema); |
f15afa13 |
204 | $replicant->connect_info($connect_info); |
d40080c3 |
205 | |
206 | ## It is undesirable for catalyst to connect at ->conect_replicants time, as |
207 | ## connections should only happen on the first request that uses the database. |
208 | ## So we try to set the driver without connecting, however this doesn't always |
209 | ## work, as a driver may need to connect to determine the DB version, and this |
210 | ## may fail. |
d6e80959 |
211 | ## |
212 | ## Why this is necessary at all, is that we need to have the final storage |
213 | ## class to apply the Replicant role. |
d40080c3 |
214 | |
215 | $self->_safely($replicant, '->_determine_driver', sub { |
216 | $replicant->_determine_driver |
217 | }); |
218 | |
f15afa13 |
219 | DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant); |
bbafcf26 |
220 | return $replicant; |
221 | } |
222 | |
f15afa13 |
223 | =head2 _safely_ensure_connected ($replicant) |
224 | |
225 | The standard ensure_connected method with throw an exception should it fail to |
226 | connect. For the master database this is desirable, but since replicants are |
227 | allowed to fail, this behavior is not desirable. This method wraps the call |
228 | to ensure_connected in an eval in order to catch any generated errors. That |
d40080c3 |
229 | way a slave can go completely offline (ie, the box itself can die) without |
f15afa13 |
230 | bringing down your entire pool of databases. |
231 | |
232 | =cut |
233 | |
234 | sub _safely_ensure_connected { |
235 | my ($self, $replicant, @args) = @_; |
d40080c3 |
236 | |
237 | return $self->_safely($replicant, '->ensure_connected', sub { |
238 | $replicant->ensure_connected(@args) |
239 | }); |
240 | } |
241 | |
242 | =head2 _safely ($replicant, $name, $code) |
243 | |
244 | Execute C<$code> for operation C<$name> catching any exceptions and printing an |
245 | error message to the C<<$replicant->debugobj>>. |
246 | |
247 | Returns 1 on success and undef on failure. |
248 | |
249 | =cut |
250 | |
251 | sub _safely { |
252 | my ($self, $replicant, $name, $code) = @_; |
253 | |
6ffb5be5 |
254 | eval { |
d40080c3 |
255 | $code->() |
6ffb5be5 |
256 | }; |
257 | if ($@) { |
13b9e828 |
258 | $replicant |
6ffb5be5 |
259 | ->debugobj |
260 | ->print( |
d40080c3 |
261 | sprintf( "Exception trying to $name for replicant %s, error is %s", |
6ffb5be5 |
262 | $replicant->_dbi_connect_info->[0], $@) |
13b9e828 |
263 | ); |
6ffb5be5 |
264 | return; |
13b9e828 |
265 | } |
6ffb5be5 |
266 | return 1; |
f15afa13 |
267 | } |
268 | |
26ab719a |
269 | =head2 connected_replicants |
270 | |
271 | Returns true if there are connected replicants. Actually is overloaded to |
272 | return the number of replicants. So you can do stuff like: |
273 | |
64cdad22 |
274 | if( my $num_connected = $storage->has_connected_replicants ) { |
275 | print "I have $num_connected connected replicants"; |
276 | } else { |
277 | print "Sorry, no replicants."; |
278 | } |
26ab719a |
279 | |
280 | This method will actually test that each replicant in the L</replicants> hashref |
281 | is actually connected, try not to hit this 10 times a second. |
282 | |
283 | =cut |
284 | |
285 | sub connected_replicants { |
64cdad22 |
286 | my $self = shift @_; |
287 | return sum( map { |
288 | $_->connected ? 1:0 |
289 | } $self->all_replicants ); |
26ab719a |
290 | } |
291 | |
50336325 |
292 | =head2 active_replicants |
293 | |
294 | This is an array of replicants that are considered to be active in the pool. |
295 | This does not check to see if they are connected, but if they are not, DBIC |
296 | should automatically reconnect them for us when we hit them with a query. |
297 | |
298 | =cut |
299 | |
300 | sub active_replicants { |
64cdad22 |
301 | my $self = shift @_; |
302 | return ( grep {$_} map { |
303 | $_->active ? $_:0 |
304 | } $self->all_replicants ); |
50336325 |
305 | } |
306 | |
26ab719a |
307 | =head2 all_replicants |
308 | |
309 | Just a simple array of all the replicant storages. No particular order to the |
310 | array is given, nor should any meaning be derived. |
311 | |
312 | =cut |
313 | |
314 | sub all_replicants { |
64cdad22 |
315 | my $self = shift @_; |
316 | return values %{$self->replicants}; |
26ab719a |
317 | } |
318 | |
4a607d7a |
319 | =head2 validate_replicants |
320 | |
321 | This does a check to see if 1) each replicate is connected (or reconnectable), |
322 | 2) that is ->is_replicating, and 3) that it is not exceeding the lag amount |
323 | defined by L</maximum_lag>. Replicants that fail any of these tests are set to |
324 | inactive, and thus removed from the replication pool. |
325 | |
326 | This tests L<all_replicants>, since a replicant that has been previous marked |
327 | as inactive can be reactived should it start to pass the validation tests again. |
328 | |
329 | See L<DBIx::Class::Storage::DBI> for more about checking if a replicating |
330 | connection is not following a master or is lagging. |
331 | |
332 | Calling this method will generate queries on the replicant databases so it is |
333 | not recommended that you run them very often. |
334 | |
13b9e828 |
335 | This method requires that your underlying storage engine supports some sort of |
336 | native replication mechanism. Currently only MySQL native replication is |
337 | supported. Your patches to make other replication types work are welcomed. |
338 | |
4a607d7a |
339 | =cut |
340 | |
341 | sub validate_replicants { |
64cdad22 |
342 | my $self = shift @_; |
343 | foreach my $replicant($self->all_replicants) { |
13b9e828 |
344 | if($self->_safely_ensure_connected($replicant)) { |
345 | my $is_replicating = $replicant->is_replicating; |
346 | unless(defined $is_replicating) { |
9901aad7 |
347 | $replicant->debugobj->print("Storage Driver ".ref($self)." Does not support the 'is_replicating' method. Assuming you are manually managing.\n"); |
13b9e828 |
348 | next; |
349 | } else { |
350 | if($is_replicating) { |
351 | my $lag_behind_master = $replicant->lag_behind_master; |
352 | unless(defined $lag_behind_master) { |
9901aad7 |
353 | $replicant->debugobj->print("Storage Driver ".ref($self)." Does not support the 'lag_behind_master' method. Assuming you are manually managing.\n"); |
13b9e828 |
354 | next; |
355 | } else { |
356 | if($lag_behind_master <= $self->maximum_lag) { |
357 | $replicant->active(1); |
358 | } else { |
359 | $replicant->active(0); |
360 | } |
361 | } |
362 | } else { |
363 | $replicant->active(0); |
364 | } |
365 | } |
64cdad22 |
366 | } else { |
64cdad22 |
367 | $replicant->active(0); |
7edf5f1c |
368 | } |
64cdad22 |
369 | } |
370 | ## Mark that we completed this validation. |
13b9e828 |
371 | $self->_last_validated(time); |
4a607d7a |
372 | } |
373 | |
26ab719a |
374 | =head1 AUTHOR |
375 | |
376 | John Napiorkowski <john.napiorkowski@takkle.com> |
377 | |
378 | =head1 LICENSE |
379 | |
380 | You may distribute this code under the same terms as Perl itself. |
381 | |
382 | =cut |
383 | |
c354902c |
384 | __PACKAGE__->meta->make_immutable; |
385 | |
cb6ec758 |
386 | 1; |