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