line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBD::Multi; |
2
|
|
|
|
|
|
|
our $VERSION = '1.02'; |
3
|
|
|
|
|
|
|
package DBD::Multi::dr; |
4
|
|
|
|
|
|
|
our $VERSION = '1.02'; |
5
|
|
|
|
|
|
|
package DBD::Multi::db; |
6
|
|
|
|
|
|
|
our $VERSION = '1.02'; |
7
|
|
|
|
|
|
|
package DBD::Multi::st; |
8
|
|
|
|
|
|
|
our $VERSION = '1.02'; |
9
|
|
|
|
|
|
|
package DBD::Multi::Handler; |
10
|
|
|
|
|
|
|
our $VERSION = '1.02'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
package DBD::Multi; |
13
|
12
|
|
|
12
|
|
353983
|
use strict; |
|
12
|
|
|
|
|
43
|
|
|
12
|
|
|
|
|
273
|
|
14
|
|
|
|
|
|
|
|
15
|
12
|
|
|
12
|
|
8638
|
use DBI; |
|
12
|
|
|
|
|
96593
|
|
|
12
|
|
|
|
|
580
|
|
16
|
|
|
|
|
|
|
DBI->setup_driver('DBD::Multi'); |
17
|
|
|
|
|
|
|
|
18
|
12
|
|
|
12
|
|
68
|
use vars qw[$err $errstr $sqlstate $drh]; |
|
12
|
|
|
|
|
18
|
|
|
12
|
|
|
|
|
1838
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
$err = 0; # DBI::err |
21
|
|
|
|
|
|
|
$errstr = ""; # DBI::errstr |
22
|
|
|
|
|
|
|
$sqlstate = ""; # DBI::state |
23
|
|
|
|
|
|
|
$drh = undef; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub driver { |
26
|
10
|
50
|
|
10
|
0
|
122494
|
return $drh if $drh; |
27
|
10
|
|
|
|
|
28
|
my($class, $attr) = @_; |
28
|
10
|
|
|
|
|
19
|
$class .= '::dr'; |
29
|
|
|
|
|
|
|
|
30
|
10
|
|
|
|
|
71
|
$drh = DBI::_new_drh($class, { |
31
|
|
|
|
|
|
|
Name => 'Multi', |
32
|
|
|
|
|
|
|
Version => $VERSION, |
33
|
|
|
|
|
|
|
Err => \$DBD::Multi::err, |
34
|
|
|
|
|
|
|
Errstr => \$DBD::Multi::errstr, |
35
|
|
|
|
|
|
|
State => \$DBD::Multi::sqlstate, |
36
|
|
|
|
|
|
|
Attribution => 'DBD::Multi, pair Networks Inc.', |
37
|
|
|
|
|
|
|
}); |
38
|
10
|
|
|
|
|
325
|
DBD::Multi::db->install_method('multi_do_all'); |
39
|
10
|
|
|
|
|
388
|
return $drh; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
####################################################################### |
43
|
|
|
|
|
|
|
package DBD::Multi::dr; |
44
|
12
|
|
|
12
|
|
69
|
use strict; |
|
12
|
|
|
|
|
18
|
|
|
12
|
|
|
|
|
336
|
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
$DBD::Multi::dr::imp_data_size = 0; |
47
|
12
|
|
|
12
|
|
5747
|
use DBD::File; |
|
12
|
|
|
|
|
491000
|
|
|
12
|
|
|
|
|
2707
|
|
48
|
|
|
|
|
|
|
|
49
|
0
|
|
|
0
|
|
0
|
sub DESTROY { shift->STORE(Active => 0) } |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub connect { |
52
|
113
|
|
|
113
|
|
16677
|
my($drh, $dbname, $user, $auth, $attr) = @_; |
53
|
113
|
|
|
|
|
370
|
my $dbh = DBI::_new_dbh( |
54
|
|
|
|
|
|
|
$drh => { |
55
|
|
|
|
|
|
|
Name => $dbname, |
56
|
|
|
|
|
|
|
USER => $user, |
57
|
|
|
|
|
|
|
CURRENT_USER => $user, |
58
|
|
|
|
|
|
|
}, |
59
|
|
|
|
|
|
|
); |
60
|
|
|
|
|
|
|
my @dsns = $attr->{dsns} && ref($attr->{dsns}) eq 'ARRAY' |
61
|
113
|
100
|
66
|
|
|
2904
|
? @{$attr->{dsns}} |
|
112
|
|
|
|
|
248
|
|
62
|
|
|
|
|
|
|
: (); |
63
|
|
|
|
|
|
|
|
64
|
113
|
50
|
|
|
|
231
|
if ( $dbname =~ /dsn=(.*)/ ) { |
65
|
0
|
|
|
|
|
0
|
push @dsns, ( -1, [$1, $user, $auth] ); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
113
|
|
|
|
|
343
|
my $handler = DBD::Multi::Handler->new({ |
69
|
|
|
|
|
|
|
dsources => [ @dsns ], |
70
|
|
|
|
|
|
|
}); |
71
|
|
|
|
|
|
|
$handler->failed_max($attr->{failed_max}) |
72
|
113
|
50
|
|
|
|
308
|
if exists $attr->{failed_max}; |
73
|
|
|
|
|
|
|
$handler->failed_expire($attr->{failed_expire}) |
74
|
113
|
100
|
|
|
|
196
|
if exists $attr->{failed_expire}; |
75
|
|
|
|
|
|
|
|
76
|
113
|
|
|
|
|
366
|
$dbh->STORE(_handler => $handler); |
77
|
113
|
|
|
|
|
287
|
$dbh->STORE(handler => $handler); # temporary |
78
|
113
|
|
|
|
|
414
|
$drh->{_handler} = $handler; |
79
|
113
|
|
|
|
|
238
|
$dbh->STORE(Active => 1); |
80
|
113
|
|
|
|
|
316
|
return $dbh; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
6
|
|
|
6
|
|
2961
|
sub data_sources { shift->FETCH('_handler')->all_sources } |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
####################################################################### |
86
|
|
|
|
|
|
|
package DBD::Multi::db; |
87
|
12
|
|
|
12
|
|
85
|
use strict; |
|
12
|
|
|
|
|
39
|
|
|
12
|
|
|
|
|
4731
|
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
$DBD::Multi::db::imp_data_size = 0; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub prepare { |
92
|
415
|
|
|
415
|
|
3037231
|
my ($dbh, $statement, @attribs) = @_; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# create a 'blank' sth |
95
|
415
|
|
|
|
|
1371
|
my ($outer, $sth) = DBI::_new_sth($dbh, { Statement => $statement }); |
96
|
|
|
|
|
|
|
|
97
|
415
|
|
|
|
|
8988
|
my $handler = $dbh->FETCH('_handler'); |
98
|
415
|
|
|
|
|
1074
|
$sth->STORE(_handler => $handler); |
99
|
|
|
|
|
|
|
|
100
|
415
|
|
|
|
|
749
|
my $_dbh = $handler->dbh; |
101
|
414
|
|
|
|
|
477
|
my $_sth; |
102
|
414
|
|
|
|
|
630
|
until ( $_sth ) { |
103
|
436
|
|
|
|
|
1783
|
$_sth = $_dbh->prepare($statement, @attribs); |
104
|
436
|
100
|
|
|
|
38224
|
unless ( $_sth ) { |
105
|
24
|
|
|
|
|
55
|
$handler->dbh_failed; |
106
|
24
|
|
|
|
|
100
|
$_dbh = $handler->dbh; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
412
|
|
|
|
|
2474
|
$sth->STORE(NUM_OF_PARAMS => $_sth->FETCH('NUM_OF_PARAMS')); |
111
|
412
|
|
|
|
|
903
|
$sth->STORE(_dbh => $_dbh); |
112
|
412
|
|
|
|
|
830
|
$sth->STORE(_sth => $_sth); |
113
|
|
|
|
|
|
|
|
114
|
412
|
|
|
|
|
1078
|
return $outer; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub multi_do_all { |
118
|
9
|
|
|
9
|
|
30084
|
my $dbh = shift; |
119
|
9
|
|
|
|
|
60
|
my $handler = $dbh->FETCH('_handler'); |
120
|
9
|
|
|
|
|
27
|
return $handler->multi_do_all( @_ ); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub disconnect { |
124
|
113
|
|
|
113
|
|
2332
|
my ($dbh) = @_; |
125
|
113
|
|
|
|
|
289
|
$dbh->STORE(Active => 0); |
126
|
113
|
|
|
|
|
2594
|
1; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub commit { |
130
|
0
|
|
|
0
|
|
0
|
my ($dbh) = @_; |
131
|
0
|
0
|
|
|
|
0
|
if ( $dbh->FETCH('Active') ) { |
132
|
0
|
0
|
|
|
|
0
|
return $dbh->FETCH('_dbh')->commit if $dbh->FETCH('_dbh'); |
133
|
|
|
|
|
|
|
} |
134
|
0
|
|
|
|
|
0
|
return; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub rollback { |
138
|
0
|
|
|
0
|
|
0
|
my ($dbh) = @_; |
139
|
0
|
0
|
|
|
|
0
|
if ( $dbh->FETCH('Active') ) { |
140
|
0
|
0
|
|
|
|
0
|
return $dbh->FETCH('_dbh')->rollback if $dbh->FETCH('_dbh'); |
141
|
|
|
|
|
|
|
} |
142
|
0
|
|
|
|
|
0
|
return; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub get_info { |
146
|
5
|
|
|
5
|
|
1914
|
my($dbh, $info_type) = @_; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# return info from current connection |
149
|
5
|
|
|
|
|
42
|
my $handler = $dbh->FETCH('_handler'); |
150
|
5
|
|
|
|
|
12
|
my $_dbh = $handler->dbh; |
151
|
5
|
|
|
|
|
19
|
return $_dbh->get_info($info_type); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub STORE { |
155
|
1017
|
|
|
1017
|
|
6412
|
my ($self, $attr, $val) = @_; |
156
|
1017
|
|
|
|
|
2239
|
$self->{$attr} = $val; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
110
|
|
|
110
|
|
6676
|
sub DESTROY { shift->disconnect } |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
####################################################################### |
162
|
|
|
|
|
|
|
package DBD::Multi::st; |
163
|
12
|
|
|
12
|
|
74
|
use strict; |
|
12
|
|
|
|
|
24
|
|
|
12
|
|
|
|
|
388
|
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
$DBD::Multi::st::imp_data_size = 0; |
166
|
|
|
|
|
|
|
|
167
|
12
|
|
|
12
|
|
63
|
use vars qw[@METHODS @FIELDS]; |
|
12
|
|
|
|
|
25
|
|
|
12
|
|
|
|
|
4029
|
|
168
|
|
|
|
|
|
|
@METHODS = qw[ |
169
|
|
|
|
|
|
|
bind_param |
170
|
|
|
|
|
|
|
bind_param_inout |
171
|
|
|
|
|
|
|
bind_param_array |
172
|
|
|
|
|
|
|
execute_array |
173
|
|
|
|
|
|
|
execute_for_fetch |
174
|
|
|
|
|
|
|
fetch |
175
|
|
|
|
|
|
|
fetchrow_arrayref |
176
|
|
|
|
|
|
|
fetchrow_array |
177
|
|
|
|
|
|
|
fetchrow_hashref |
178
|
|
|
|
|
|
|
fetchall_arrayref |
179
|
|
|
|
|
|
|
fetchall_hashref |
180
|
|
|
|
|
|
|
bind_col |
181
|
|
|
|
|
|
|
bind_columns |
182
|
|
|
|
|
|
|
dump_results |
183
|
|
|
|
|
|
|
]; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
@FIELDS = qw[ |
186
|
|
|
|
|
|
|
NUM_OF_FIELDS |
187
|
|
|
|
|
|
|
CursorName |
188
|
|
|
|
|
|
|
ParamValues |
189
|
|
|
|
|
|
|
RowsInCache |
190
|
|
|
|
|
|
|
]; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub execute { |
193
|
410
|
|
|
410
|
|
4095
|
my $sth = shift; |
194
|
410
|
|
|
|
|
785
|
my $_sth = $sth->FETCH('_sth'); |
195
|
|
|
|
|
|
|
my $params = @_ |
196
|
|
|
|
|
|
|
? $sth->{f_params} = [ @_ ] |
197
|
410
|
100
|
|
|
|
915
|
: $sth->{f_params}; |
198
|
|
|
|
|
|
|
|
199
|
410
|
100
|
|
|
|
771
|
$sth->finish if $sth->FETCH('Active'); |
200
|
410
|
|
|
|
|
677
|
$sth->{Active} = 1; |
201
|
410
|
|
|
|
|
443
|
my $rc = $_sth->execute(@{$params}); |
|
410
|
|
|
|
|
140518
|
|
202
|
|
|
|
|
|
|
|
203
|
410
|
|
|
|
|
1242
|
for my $field ( @FIELDS ) { |
204
|
1640
|
|
|
|
|
4156
|
my $value = $_sth->FETCH($field); |
205
|
1640
|
100
|
100
|
|
|
3912
|
$sth->STORE($field => $value) |
206
|
|
|
|
|
|
|
unless ! defined $value |
207
|
|
|
|
|
|
|
|| defined $sth->FETCH($field); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
410
|
|
|
|
|
1163
|
return $rc; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub FETCH { |
214
|
2451
|
|
|
2451
|
|
3261
|
my ($sth, $attrib) = @_; |
215
|
2451
|
100
|
|
|
|
15806
|
$sth->{'_sth'}->FETCH($attrib) || $sth->{$attrib}; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub STORE { |
219
|
2056
|
|
|
2056
|
|
2939
|
my ($self, $attr, $val) = @_; |
220
|
2056
|
|
|
|
|
3660
|
$self->{$attr} = $val; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
3
|
|
|
3
|
|
24
|
sub rows { shift->FETCH('_sth')->rows } |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub finish { |
226
|
402
|
|
|
402
|
|
2550
|
my ($sth) = @_; |
227
|
402
|
|
|
|
|
966
|
$sth->STORE(Active => 0); |
228
|
402
|
|
|
|
|
791
|
return $sth->FETCH('_sth')->finish; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
foreach my $method ( @METHODS ) { |
232
|
12
|
|
|
12
|
|
79
|
no strict; |
|
12
|
|
|
|
|
27
|
|
|
12
|
|
|
|
|
778
|
|
233
|
407
|
|
|
407
|
|
2088
|
*{$method} = sub { shift->FETCH('_sth')->$method(@_) }; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
####################################################################### |
237
|
|
|
|
|
|
|
package DBD::Multi::Handler; |
238
|
12
|
|
|
12
|
|
77
|
use strict; |
|
12
|
|
|
|
|
30
|
|
|
12
|
|
|
|
|
310
|
|
239
|
|
|
|
|
|
|
|
240
|
12
|
|
|
12
|
|
55
|
use base qw[Class::Accessor::Fast]; |
|
12
|
|
|
|
|
22
|
|
|
12
|
|
|
|
|
4736
|
|
241
|
12
|
|
|
12
|
|
31416
|
use Sys::SigAction qw(timeout_call); |
|
12
|
|
|
|
|
118161
|
|
|
12
|
|
|
|
|
624
|
|
242
|
12
|
|
|
12
|
|
82
|
use List::Util qw(shuffle); |
|
12
|
|
|
|
|
148
|
|
|
12
|
|
|
|
|
13501
|
|
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=begin ImplementationNotes |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
dsources - This thing changes from an arrayref to a hashref during construction. :( |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
Initially, when data is passed in during construction, it's an arrayref |
249
|
|
|
|
|
|
|
containing the 'dsns' param from the user's connect() call. |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
Later, when _configure_dsources gets called, it turns into a multi-dimension |
252
|
|
|
|
|
|
|
hashref: |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
$dsources->{$pri}->{$dsource_id} = 1; |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
The first key is the priority number, the second key is the data source index |
257
|
|
|
|
|
|
|
number. The value is always just a true value. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
nextid - A counter. Stores the index number of the next data source to be added. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
all_dsources - A hashref. Maps index number to the connect data. |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
current_dsource - The most recent chosen datasource index number. |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
used - A hashref. Keys are index numbers. Values are true when the datasource |
266
|
|
|
|
|
|
|
has been previously assigned and we want to prefer other datasources of the |
267
|
|
|
|
|
|
|
same priority (for round-robin load distribution). |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
failed - A hashref. Keys are index numbers. Values are counters indicating |
270
|
|
|
|
|
|
|
how many times the data source has failed. |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
failed_last - A hashref. Keys are index number. Values are unix timestamp |
273
|
|
|
|
|
|
|
indicating the most recent time a data source failed. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
failed_max - A scalar value. Number of times a datasource may fail before we |
276
|
|
|
|
|
|
|
stop trying it. |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
failed_expire - A scalar value. Number of seconds since we stopped trying a |
279
|
|
|
|
|
|
|
datasource before we'll try it again. |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
timeout - A scalar value. Number of seconds we try to connect to a datasource |
282
|
|
|
|
|
|
|
before giving up. |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=end ImplementationNotes |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=cut |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors(qw[ |
289
|
|
|
|
|
|
|
dsources |
290
|
|
|
|
|
|
|
nextid |
291
|
|
|
|
|
|
|
all_dsources |
292
|
|
|
|
|
|
|
current_dsource |
293
|
|
|
|
|
|
|
used |
294
|
|
|
|
|
|
|
failed |
295
|
|
|
|
|
|
|
failed_last |
296
|
|
|
|
|
|
|
failed_max |
297
|
|
|
|
|
|
|
failed_expire |
298
|
|
|
|
|
|
|
timeout |
299
|
|
|
|
|
|
|
]); |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub new { |
302
|
113
|
|
|
113
|
|
186
|
my ($class, $args) = @_; |
303
|
113
|
|
|
|
|
316
|
my $self = $class->SUPER::new($args); |
304
|
113
|
50
|
|
|
|
2680
|
$self->nextid(0) unless defined $self->nextid; |
305
|
113
|
|
|
|
|
3765
|
$self->all_dsources({}); |
306
|
113
|
|
|
|
|
1872
|
$self->used({}); |
307
|
113
|
|
|
|
|
1838
|
$self->failed({}); |
308
|
113
|
|
|
|
|
1874
|
$self->failed_last({}); |
309
|
113
|
50
|
|
|
|
1794
|
$self->failed_max(3) unless defined $self->failed_max; |
310
|
113
|
50
|
|
|
|
3485
|
$self->failed_expire(60*5) unless defined $self->failed_expire; |
311
|
113
|
50
|
|
|
|
3544
|
$self->timeout( 5 ) unless defined $self->timeout; |
312
|
113
|
|
|
|
|
2222
|
$self->_configure_dsources; |
313
|
113
|
|
|
|
|
159
|
return $self; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub all_sources { |
317
|
6
|
|
|
6
|
|
12
|
my ($self) = @_; |
318
|
6
|
|
|
|
|
7
|
return values %{$self->all_dsources}; |
|
6
|
|
|
|
|
122
|
|
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub add_to_pri { |
322
|
234
|
|
|
234
|
|
322
|
my ($self, $pri, $dsource) = @_; |
323
|
234
|
|
|
|
|
3010
|
my $dsource_id = $self->nextid; |
324
|
234
|
|
|
|
|
3394
|
my $dsources = $self->dsources; |
325
|
234
|
|
|
|
|
3363
|
my $all = $self->all_dsources; |
326
|
|
|
|
|
|
|
|
327
|
234
|
|
|
|
|
841
|
$all->{$dsource_id} = $dsource; |
328
|
234
|
|
|
|
|
338
|
$dsources->{$pri}->{$dsource_id} = 1; |
329
|
|
|
|
|
|
|
|
330
|
234
|
|
|
|
|
3123
|
$self->nextid($dsource_id + 1); |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub dbh { |
334
|
450
|
|
|
450
|
|
531
|
my $self = shift; |
335
|
450
|
|
|
|
|
707
|
my $dbh = $self->_connect_dsource; |
336
|
447
|
100
|
|
|
|
1286
|
return $dbh if $dbh; |
337
|
6
|
|
|
|
|
12
|
$self->dbh_failed; |
338
|
6
|
|
|
|
|
32
|
$self->dbh; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub dbh_failed { |
342
|
30
|
|
|
30
|
|
47
|
my ($self) = @_; |
343
|
|
|
|
|
|
|
|
344
|
30
|
|
|
|
|
529
|
my $current_dsource = $self->current_dsource; |
345
|
30
|
|
|
|
|
490
|
$self->failed->{$current_dsource}++; |
346
|
30
|
|
|
|
|
473
|
$self->failed_last->{$current_dsource} = time; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub _purge_old_failures { |
350
|
450
|
|
|
450
|
|
512
|
my ($self) = @_; |
351
|
450
|
|
|
|
|
509
|
my $now = time; |
352
|
450
|
|
|
|
|
461
|
my @all = keys %{$self->all_dsources}; |
|
450
|
|
|
|
|
8509
|
|
353
|
|
|
|
|
|
|
|
354
|
450
|
|
|
|
|
2537
|
foreach my $dsource ( @all ) { |
355
|
966
|
100
|
|
|
|
15020
|
next unless $self->failed->{$dsource}; |
356
|
175
|
100
|
|
|
|
2746
|
if ( ($now - $self->failed_last->{$dsource}) > $self->failed_expire ) { |
357
|
1
|
|
|
|
|
39
|
delete $self->failed->{$dsource}; |
358
|
1
|
|
|
|
|
17
|
delete $self->failed_last->{$dsource}; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
sub _pick_dsource { |
364
|
450
|
|
|
450
|
|
540
|
my ($self) = @_; |
365
|
450
|
|
|
|
|
732
|
$self->_purge_old_failures; |
366
|
450
|
|
|
|
|
9034
|
my $dsources = $self->dsources; |
367
|
450
|
|
|
|
|
1459
|
my @pri = sort { $a <=> $b } keys %{$dsources}; |
|
266
|
|
|
|
|
794
|
|
|
450
|
|
|
|
|
1224
|
|
368
|
|
|
|
|
|
|
|
369
|
450
|
|
|
|
|
727
|
foreach my $pri ( @pri ) { |
370
|
566
|
|
|
|
|
938
|
my $dsource = $self->_pick_pri_dsource($dsources->{$pri}); |
371
|
566
|
100
|
|
|
|
971
|
if ( defined $dsource ) { |
372
|
448
|
|
|
|
|
6143
|
$self->current_dsource($dsource); |
373
|
448
|
|
|
|
|
2808
|
return; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
2
|
|
|
|
|
31
|
$self->used({}); |
378
|
|
|
|
|
|
|
return $self->_pick_dsource |
379
|
2
|
50
|
|
|
|
12
|
if (grep {$self->failed->{$_} >= $self->failed_max} keys(%{$self->failed})) < keys(%{$self->all_dsources}); |
|
8
|
|
|
|
|
203
|
|
|
2
|
|
|
|
|
28
|
|
|
2
|
|
|
|
|
59
|
|
380
|
2
|
|
|
|
|
97
|
die("All data sources failed!"); |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
### _pick_pri_dsource |
384
|
|
|
|
|
|
|
# Given a list of data sources, all of the same priority, choose one to use. |
385
|
|
|
|
|
|
|
# Passed in a structure like this: |
386
|
|
|
|
|
|
|
# _pick_pri_dsource( $self, { 3 => 1, 4 => 1, 5 => 1 } ) |
387
|
|
|
|
|
|
|
# Where the keys 3,4,5 are dsource id's, and the values are always true. |
388
|
|
|
|
|
|
|
sub _pick_pri_dsource { |
389
|
566
|
|
|
566
|
|
738
|
my ($self, $dsources) = @_; |
390
|
566
|
|
|
|
|
599
|
my @dsources = sort { $a <=> $b } keys %{$dsources}; # Indexes of data sources to try. |
|
245
|
|
|
|
|
654
|
|
|
566
|
|
|
|
|
1200
|
|
391
|
566
|
|
|
|
|
841
|
my @used = grep { exists $self->used->{$_} } @dsources; # List of data sources already used. |
|
811
|
|
|
|
|
11681
|
|
392
|
566
|
100
|
|
|
|
2567
|
my @failed = grep { exists($self->failed->{$_}) && $self->failed->{$_} >= $self->failed_max } @dsources; # List of data sources that won't be tried. |
|
811
|
|
|
|
|
12048
|
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
# We've used them all and they all failed. Escallate. |
395
|
566
|
100
|
100
|
|
|
7489
|
return if @used == @dsources && @failed == @dsources; |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
# We've used them all but some are good. Purge and reuse. |
398
|
448
|
100
|
|
|
|
830
|
delete @{$self->used}{@dsources} if @used == @dsources; |
|
271
|
|
|
|
|
3615
|
|
399
|
|
|
|
|
|
|
|
400
|
448
|
|
|
|
|
1997
|
foreach my $dsource ( shuffle @dsources ) { |
401
|
|
|
|
|
|
|
next if $self->failed->{$dsource} |
402
|
485
|
100
|
100
|
|
|
6544
|
&& $self->failed->{$dsource} >= $self->failed_max; |
403
|
484
|
100
|
|
|
|
8346
|
next if $self->used->{$dsource}; |
404
|
|
|
|
|
|
|
|
405
|
448
|
|
|
|
|
6876
|
$self->used->{$dsource} = 1; |
406
|
448
|
|
|
|
|
1968
|
return $dsource; |
407
|
|
|
|
|
|
|
} |
408
|
0
|
|
|
|
|
0
|
return; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
sub _configure_dsources { |
412
|
113
|
|
|
113
|
|
165
|
my ($self) = @_; |
413
|
113
|
|
|
|
|
1429
|
my $dsources = $self->dsources; |
414
|
113
|
|
|
|
|
1743
|
$self->dsources({}); |
415
|
|
|
|
|
|
|
|
416
|
113
|
|
|
|
|
474
|
while ( my $pri = shift @{$dsources} ) { |
|
347
|
|
|
|
|
1510
|
|
417
|
234
|
50
|
|
|
|
236
|
my $dsource = shift @{$dsources} or last; |
|
234
|
|
|
|
|
391
|
|
418
|
234
|
|
|
|
|
358
|
$self->add_to_pri($pri => $dsource); |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
sub _connect_dsource { |
423
|
534
|
|
|
534
|
|
699
|
my ($self, $dsource) = @_; |
424
|
534
|
100
|
|
|
|
949
|
unless ( $dsource ) { |
425
|
450
|
|
|
|
|
747
|
$self->_pick_dsource; |
426
|
448
|
|
|
|
|
5821
|
$dsource = $self->all_dsources->{$self->current_dsource}; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
# Support ready-made handles |
430
|
532
|
100
|
|
|
|
8446
|
return $dsource if UNIVERSAL::isa($dsource, 'DBI::db'); |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
# Support code-refs which return handles |
433
|
477
|
100
|
|
|
|
908
|
if (ref $dsource eq 'CODE') { |
434
|
213
|
|
|
|
|
370
|
my $handle = $dsource->(); |
435
|
213
|
100
|
|
|
|
64610
|
return $handle if UNIVERSAL::isa($handle, 'DBI::db'); |
436
|
6
|
|
|
|
|
11
|
return undef; # Connect by coderef failed. |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
|
439
|
264
|
|
|
|
|
253
|
my $dbh; |
440
|
264
|
|
|
|
|
665
|
local $ENV{DBI_AUTOPROXY}; |
441
|
264
|
50
|
|
264
|
|
3955
|
if (timeout_call( $self->timeout, sub { $dbh = DBI->connect_cached(@{$dsource}) } )) { |
|
264
|
|
|
|
|
30480
|
|
|
264
|
|
|
|
|
766
|
|
442
|
|
|
|
|
|
|
#warn "Timeout[", $self->current_dsource, "] at ", time, "\n"; |
443
|
|
|
|
|
|
|
} |
444
|
263
|
|
|
|
|
67701
|
return $dbh; |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
sub connect_dsource { |
448
|
84
|
|
|
84
|
|
141
|
my ($self, $dsource) = @_; |
449
|
84
|
|
|
|
|
151
|
$self->_connect_dsource($dsource); |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub multi_do_all { |
453
|
21
|
|
|
21
|
|
38
|
my ($self, $code) = @_; |
454
|
|
|
|
|
|
|
|
455
|
21
|
|
|
|
|
24
|
my @all = values %{$self->all_dsources}; |
|
21
|
|
|
|
|
488
|
|
456
|
|
|
|
|
|
|
|
457
|
21
|
|
|
|
|
135
|
foreach my $source ( @all ) { |
458
|
84
|
|
|
|
|
714883
|
my $dbh = $self->connect_dsource($source); |
459
|
84
|
50
|
|
|
|
175
|
next unless $dbh; |
460
|
84
|
100
|
|
|
|
641
|
if ( $dbh->{handler} ) { |
461
|
12
|
|
|
|
|
48
|
$dbh->{handler}->multi_do_all($code, $source); |
462
|
12
|
|
|
|
|
56832
|
next; |
463
|
|
|
|
|
|
|
} |
464
|
72
|
|
|
|
|
203
|
$code->($dbh); |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
1; |
469
|
|
|
|
|
|
|
__END__ |