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