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