3
package Net::HandlerSocket::HSPool;
7
use Net::HandlerSocket;
13
reopen_interval => 60,
16
return bless $self, $_[0];
21
$self->{hostmap} = { };
25
my ($self, $obj) = @_;
26
my $error_func = $self->{config}->{error};
27
if (defined($error_func)) {
28
return &{$error_func}($obj);
34
my ($self, $obj) = @_;
35
my $warning_func = $self->{config}->{warning};
36
if (defined($warning_func)) {
37
return &{$warning_func}($obj);
42
my ($self, $dbtbl) = @_;
43
my $hcent = $self->{config}->{hostmap}->{$dbtbl};
44
if (!defined($hcent)) {
45
$self->on_error("get_conf: $dbtbl not found");
54
sub resolve_hostname {
55
my ($self, $hcent, $host_ip_list) = @_;
56
if (defined($host_ip_list)) {
57
if (scalar(@$host_ip_list) > 0) {
58
$hcent->{host} = shift(@$host_ip_list);
61
return undef; # no more ip
63
my $host = $hcent->{host}; # unresolved name
64
$hcent->{hostname} = $host;
65
my $resolve_list_func = $self->{config}->{resolve_list};
66
if (defined($resolve_list_func)) {
67
$host_ip_list = &{$resolve_list_func}($host);
68
if (scalar(@$host_ip_list) > 0) {
69
$hcent->{host} = shift(@$host_ip_list);
72
return undef; # no more ip
74
my $resolve_func = $self->{config}->{resolve};
75
if (defined($resolve_func)) {
76
$hcent->{host} = &{$resolve_func}($host);
79
my $packed = gethostbyname($host);
80
if (!defined($packed)) {
83
$hcent->{host} = inet_ntoa($packed);
88
my ($self, $db, $tbl, $idx, $cols, $exec_multi, $exec_args) = @_;
90
my $dbtbl = join('.', $db, $tbl);
91
my $hcent = $self->get_conf($dbtbl); # copy
92
if (!defined($hcent)) {
95
my $hmkey = join(':', $hcent->{host}, $hcent->{port});
96
my $hment = $self->{hostmap}->{$hmkey};
97
# [ open_time, handle, index_map, host, next_index_id ]
100
if (!defined($hment) ||
101
$hment->[0] + $self->{reopen_interval} < $now ||
102
!$hment->[1]->stable_point()) {
103
$host_ip_list = $self->resolve_hostname($hcent, $host_ip_list);
104
if (!defined($host_ip_list)) {
105
my $hostport = $hmkey . '(' . $hcent->{host} . ')';
106
$self->on_error("HSPool::get_handle" .
107
"($db, $tbl, $idx, $cols): host=$hmkey: " .
108
"no more active ip");
111
my $hnd = new Net::HandlerSocket($hcent);
113
$hment = [ $now, $hnd, \%m, $hcent->{host}, 1 ];
114
$self->{hostmap}->{$hmkey} = $hment;
116
my $hnd = $hment->[1];
117
my $idxmap = $hment->[2];
118
my $imkey = join(':', $idx, $cols);
119
my $idx_id = $idxmap->{$imkey};
120
if (!defined($idx_id)) {
121
$idx_id = $hment->[4];
122
my $e = $hnd->open_index($idx_id, $db, $tbl, $idx, $cols);
124
my $estr = $hnd->get_error();
125
my $hostport = $hmkey . '(' . $hcent->{host} . ')';
126
my $errmess = "HSPool::get_handle open_index" .
127
"($db, $tbl, $idx, $cols): host=$hostport " .
129
$self->on_warning($errmess);
135
$idxmap->{$imkey} = $idx_id;
139
for my $cmdent (@$exec_args) {
140
$cmdent->[0] = $idx_id;
142
if (scalar(@$exec_args) == 0) {
145
$resarr = $hnd->execute_multi($exec_args);
148
for my $res (@$resarr) {
149
if ($res->[0] != 0) {
150
my $cmdent = $exec_args->[$i];
152
my $estr = $res->[1];
153
my $op = $cmdent->[1];
154
my $kfvs = $cmdent->[2];
155
my $kvstr = defined($kfvs)
156
? join(',', @$kfvs) : '';
157
my $limit = $cmdent->[3] || 0;
158
my $skip = $cmdent->[4] || 0;
159
my $hostport = $hmkey . '(' . $hcent->{host}
161
my $errmess = "HSPool::get_handle execm" .
162
"($db, $tbl, $idx, [$cols], " .
163
"($idx_id), $op, [$kvstr] " .
165
"host=$hostport err=$ec($estr)";
166
if ($res->[0] < 0 || $res->[0] == 2) {
167
$self->on_warning($errmess);
172
$self->on_error($errmess);
180
my $res = $hnd->execute_find($idx_id, @$exec_args);
181
if ($res->[0] != 0) {
182
my ($op, $kfvals, $limit, $skip) = @$exec_args;
184
my $estr = $res->[1];
185
my $kvstr = join(',', @$kfvals);
186
my $hostport = $hmkey . '(' . $hcent->{host} . ')';
187
my $errmess = "HSPool::get_handle exec" .
188
"($db, $tbl, $idx, [$cols], ($idx_id), " .
189
"$op, [$kvstr], $limit, $skip): " .
190
"host=$hostport err=$ec($estr)";
191
if ($res->[0] < 0 || $res->[0] == 2) {
192
$self->on_warning($errmess);
197
$self->on_error($errmess);
206
my ($self, $db, $tbl, $idx, $cols, $op, $kfvals, $limit, $skip) = @_;
207
# cols: comma separated list
211
my $res = $self->get_handle_exec($db, $tbl, $idx, $cols,
212
0, [ $op, $kfvals, $limit, $skip ]);
216
sub index_find_multi {
217
my ($self, $db, $tbl, $idx, $cols, $cmdlist) = @_;
218
# cols : comma separated list
219
# cmdlist : [ dummy, op, kfvals, limit, skip ]
221
my $resarr = $self->get_handle_exec($db, $tbl, $idx, $cols,
226
sub result_single_to_arrarr {
227
my ($numcols, $hsres, $ret) = @_;
228
my $hsreslen = scalar(@$hsres);
229
my $rlen = int($hsreslen / $numcols);
230
$ret = [ ] if !defined($ret);
233
for (my $i = 0; $i < $rlen; ++$i) {
234
my @a = splice(@$hsres, $p, $numcols);
238
return $ret; # arrayref of arrayrefs
241
sub result_multi_to_arrarr {
242
my ($numcols, $mhsres, $ret) = @_;
243
$ret = [ ] if !defined($ret);
244
for my $hsres (@$mhsres) {
245
my $hsreslen = scalar(@$hsres);
246
my $rlen = int($hsreslen / $numcols);
248
for (my $i = 0; $i < $rlen; ++$i) {
249
my @a = splice(@$hsres, $p, $numcols);
254
return $ret; # arrayref of arrayrefs
257
sub result_single_to_hasharr {
258
my ($names, $hsres, $ret) = @_;
259
my $nameslen = scalar(@$names);
260
my $hsreslen = scalar(@$hsres);
261
my $rlen = int($hsreslen / $nameslen);
262
$ret = [ ] if !defined($ret);
264
for (my $i = 0; $i < $rlen; ++$i) {
266
for (my $j = 0; $j < $nameslen; ++$j, ++$p) {
267
$h{$names->[$j]} = $hsres->[$p];
271
return $ret; # arrayref of hashrefs
274
sub result_multi_to_hasharr {
275
my ($names, $mhsres, $ret) = @_;
276
my $nameslen = scalar(@$names);
277
$ret = [ ] if !defined($ret);
278
for my $hsres (@$mhsres) {
279
my $hsreslen = scalar(@$hsres);
280
my $rlen = int($hsreslen / $nameslen);
282
for (my $i = 0; $i < $rlen; ++$i) {
284
for (my $j = 0; $j < $nameslen; ++$j, ++$p) {
285
$h{$names->[$j]} = $hsres->[$p];
290
return $ret; # arrayref of hashrefs
293
sub result_single_to_hashhash {
294
my ($names, $key, $hsres, $ret) = @_;
295
my $nameslen = scalar(@$names);
296
my $hsreslen = scalar(@$hsres);
297
my $rlen = int($hsreslen / $nameslen);
298
$ret = { } if !defined($ret);
300
for (my $i = 0; $i < $rlen; ++$i) {
302
for (my $j = 0; $j < $nameslen; ++$j, ++$p) {
303
$h{$names->[$j]} = $hsres->[$p];
306
$ret->{$k} = \%h if defined($k);
308
return $ret; # hashref of hashrefs
311
sub result_multi_to_hashhash {
312
my ($names, $key, $mhsres, $ret) = @_;
313
my $nameslen = scalar(@$names);
314
$ret = { } if !defined($ret);
315
for my $hsres (@$mhsres) {
316
my $hsreslen = scalar(@$hsres);
317
my $rlen = int($hsreslen / $nameslen);
319
for (my $i = 0; $i < $rlen; ++$i) {
321
for (my $j = 0; $j < $nameslen; ++$j, ++$p) {
322
$h{$names->[$j]} = $hsres->[$p];
325
$ret->{$k} = \%h if defined($k);
328
return $ret; # hashref of hashrefs
331
sub select_cols_where_eq_aa {
332
# SELECT $cols FROM $db.$tbl WHERE $idx_key = $kv LIMIT 1
333
my ($self, $db, $tbl, $idx, $cols_aref, $kv_aref) = @_;
334
my $cols_str = join(',', @$cols_aref);
335
my $res = $self->index_find($db, $tbl, $idx, $cols_str, '=', $kv_aref);
336
return result_single_to_arrarr(scalar(@$cols_aref), $res);
339
sub select_cols_where_eq_hh {
340
# SELECT $cols FROM $db.$tbl WHERE $idx_key = $kv LIMIT 1
341
my ($self, $db, $tbl, $idx, $cols_aref, $kv_aref, $retkey) = @_;
342
my $cols_str = join(',', @$cols_aref);
343
my $res = $self->index_find($db, $tbl, $idx, $cols_str, '=', $kv_aref);
344
my $r = result_single_to_hashhash($cols_aref, $retkey, $res);
348
sub select_cols_where_in_hh {
349
# SELECT $cols FROM $db.$tbl WHERE $idx_key in ($vals)
350
my ($self, $db, $tbl, $idx, $cols_aref, $vals_aref, $retkey) = @_;
351
my $cols_str = join(',', @$cols_aref);
353
for my $v (@$vals_aref) {
354
push(@cmdlist, [ -1, '=', [ $v ] ]);
356
my $res = $self->index_find_multi($db, $tbl, $idx, $cols_str,
358
return result_multi_to_hashhash($cols_aref, $retkey, $res);