line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Monitoring::Livestatus::Class::Lite; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Monitoring::Livestatus::Class::Lite - Object-Oriented interface for |
6
|
|
|
|
|
|
|
Monitoring::Livestatus |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 DESCRIPTION |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
This module is an object-oriented interface for Monitoring::Livestatus. |
11
|
|
|
|
|
|
|
Just like Monitoring::Livestatus::Class but without Moose. |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 SYNOPSIS |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use Monitoring::Livestatus::Class::Lite; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my $class = Monitoring::Livestatus::Class::Lite->new( |
18
|
|
|
|
|
|
|
peer => '/var/lib/nagios3/rw/livestatus.sock' |
19
|
|
|
|
|
|
|
); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $hosts = $class->table('hosts'); |
22
|
|
|
|
|
|
|
my @data = $hosts->columns('display_name')->filter( |
23
|
|
|
|
|
|
|
{ display_name => { '-or' => [qw/test_host_47 test_router_3/] } } |
24
|
|
|
|
|
|
|
)->hashref_array(); |
25
|
|
|
|
|
|
|
print Dumper \@data; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head2 peer |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
Connection point to the livestatus addon. This can be a unix |
32
|
|
|
|
|
|
|
domain or tcp socket. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head3 Socket |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my $class = Monitoring::Livestatus::Class->new( |
37
|
|
|
|
|
|
|
peer => '/var/lib/nagios3/rw/livestatus.sock' |
38
|
|
|
|
|
|
|
); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head3 TCP Connection |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
my $class = Monitoring::Livestatus::Class->new( |
43
|
|
|
|
|
|
|
peer => '192.168.1.1:2134' |
44
|
|
|
|
|
|
|
); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 ENVIRONMENT VARIABLES |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head2 MONITORING_LIVESTATUS_CLASS_TRACE |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Print tracer output from this object. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head2 MONITORING_LIVESTATUS_CLASS_TEST_PEER |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Set peer for live tests. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=cut |
57
|
|
|
|
|
|
|
|
58
|
5
|
|
|
5
|
|
32399
|
use warnings; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
190
|
|
59
|
5
|
|
|
5
|
|
29
|
use strict; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
174
|
|
60
|
5
|
|
|
5
|
|
39
|
use Carp; |
|
5
|
|
|
|
|
14
|
|
|
5
|
|
|
|
|
445
|
|
61
|
5
|
|
|
5
|
|
38
|
use Scalar::Util qw/blessed/; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
482
|
|
62
|
5
|
|
|
5
|
|
28
|
use List::Util qw/first/; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
521
|
|
63
|
5
|
|
|
5
|
|
5863
|
use Monitoring::Livestatus; |
|
5
|
|
|
|
|
410957
|
|
|
5
|
|
|
|
|
19425
|
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
our $VERSION = '0.05'; |
66
|
|
|
|
|
|
|
our $TRACE = $ENV{'MONITORING_LIVESTATUS_CLASS_TRACE'} || 0; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
our $compining_prefix = ''; |
69
|
|
|
|
|
|
|
our $filter_mode = ''; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
################################################################################ |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 METHODS |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head2 new |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
new($options) |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
create new Class module |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=cut |
82
|
|
|
|
|
|
|
sub new { |
83
|
3
|
|
|
3
|
1
|
1116
|
my($class, $self) = @_; |
84
|
|
|
|
|
|
|
|
85
|
3
|
50
|
|
|
|
10
|
if(ref $self ne 'HASH') { |
86
|
3
|
|
|
|
|
14
|
$self = { 'peer' => $self }; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
3
|
|
|
|
|
19
|
$self->{backend_obj} = Monitoring::Livestatus->new( |
90
|
|
|
|
|
|
|
name => $self->{'name'}, |
91
|
|
|
|
|
|
|
peer => $self->{'peer'}, |
92
|
|
|
|
|
|
|
verbose => $self->{'verbose'}, |
93
|
|
|
|
|
|
|
); |
94
|
3
|
|
|
|
|
1114
|
bless($self, $class); |
95
|
|
|
|
|
|
|
|
96
|
3
|
|
|
|
|
9
|
return $self; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
################################################################################ |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head2 table |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
table($tablename) |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
return instance for this table |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
sub table { |
109
|
0
|
|
|
0
|
1
|
0
|
my($self, $name) = @_; |
110
|
0
|
0
|
|
|
|
0
|
confess('need table name') unless $name; |
111
|
0
|
|
|
|
|
0
|
my $table = { |
112
|
|
|
|
|
|
|
'_class' => $self->{'backend_obj'}, |
113
|
|
|
|
|
|
|
'_table' => $name, |
114
|
|
|
|
|
|
|
}; |
115
|
0
|
|
|
|
|
0
|
bless($table, 'Monitoring::Livestatus::Class::Lite'); |
116
|
0
|
|
|
|
|
0
|
return $table; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
################################################################################ |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=head2 columns |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
columns($columns) |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
list of columns to fetch |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=cut |
128
|
|
|
|
|
|
|
sub columns { |
129
|
0
|
|
|
0
|
1
|
0
|
my($self, @columns) = @_; |
130
|
0
|
|
|
|
|
0
|
$self->{'_columns'} = \@columns; |
131
|
0
|
|
|
|
|
0
|
return $self; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
################################################################################ |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head2 options |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
options($options) |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
set query options |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=cut |
143
|
|
|
|
|
|
|
sub options { |
144
|
0
|
|
|
0
|
1
|
0
|
my($self, $options) = @_; |
145
|
0
|
|
|
|
|
0
|
$self->{'_options'} = $options; |
146
|
0
|
|
|
|
|
0
|
return $self; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
################################################################################ |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head2 filter |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
filter($filter) |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
filter result set |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=cut |
158
|
|
|
|
|
|
|
sub filter { |
159
|
0
|
|
|
0
|
1
|
0
|
my($self, $filter) = @_; |
160
|
0
|
0
|
|
|
|
0
|
$self->{'_filter'} = $self->{'_filter'} ? [@{$self->{'_filter'}}, $filter] : [$filter]; |
|
0
|
|
|
|
|
0
|
|
161
|
0
|
|
|
|
|
0
|
return $self; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
################################################################################ |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=head2 stats |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
stats($statsfilter) |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
set stats filter |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=cut |
173
|
|
|
|
|
|
|
sub stats { |
174
|
0
|
|
|
0
|
1
|
0
|
my($self, $filter) = @_; |
175
|
0
|
0
|
|
|
|
0
|
$self->{'_statsfilter'} = $self->{'_statsfilter'} ? [@{$self->{'_statsfilter'}}, $filter] : [$filter]; |
|
0
|
|
|
|
|
0
|
|
176
|
0
|
|
|
|
|
0
|
return $self; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
################################################################################ |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head2 hashref_pk |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
hashref_pk($key) |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
return result as hash ref by key |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=cut |
188
|
|
|
|
|
|
|
sub hashref_pk { |
189
|
0
|
|
|
0
|
1
|
0
|
my($self, $key) = @_; |
190
|
|
|
|
|
|
|
|
191
|
0
|
0
|
|
|
|
0
|
croak("no key!") unless $key; |
192
|
|
|
|
|
|
|
|
193
|
0
|
|
|
|
|
0
|
my %indexed; |
194
|
0
|
|
|
|
|
0
|
my @data = $self->hashref_array(); |
195
|
0
|
|
|
|
|
0
|
for my $row (@data) { |
196
|
0
|
|
|
|
|
0
|
$indexed{$row->{$key}} = $row; |
197
|
|
|
|
|
|
|
} |
198
|
0
|
0
|
|
|
|
0
|
return wantarray ? %indexed : \%indexed; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
################################################################################ |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=head2 hashref_array |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
hashref_array() |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
return result as array |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=cut |
210
|
|
|
|
|
|
|
sub hashref_array { |
211
|
0
|
|
|
0
|
1
|
0
|
my($self) = @_; |
212
|
0
|
|
|
|
|
0
|
my @data = $self->_execute(); |
213
|
0
|
0
|
|
|
|
0
|
return wantarray ? @data : \@data; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
################################################################################ |
217
|
|
|
|
|
|
|
# INTERNAL SUBs |
218
|
|
|
|
|
|
|
################################################################################ |
219
|
|
|
|
|
|
|
sub _execute { |
220
|
0
|
|
|
0
|
|
0
|
my($self) = @_; |
221
|
|
|
|
|
|
|
|
222
|
0
|
0
|
|
|
|
0
|
confess("no table??") unless $self->{'_table'}; |
223
|
|
|
|
|
|
|
|
224
|
0
|
|
|
|
|
0
|
my @statements = (); |
225
|
0
|
0
|
|
|
|
0
|
if( $self->{'_columns'} ) { |
226
|
0
|
|
|
|
|
0
|
push @statements, sprintf('Columns: %s',join(' ',@{ $self->{'_columns'} })); |
|
0
|
|
|
|
|
0
|
|
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# filtering |
230
|
0
|
0
|
|
|
|
0
|
if( $self->{'_filter'} ) { |
231
|
0
|
|
|
|
|
0
|
push @statements, @{$self->_apply_filter($self->{'_filter'})}; |
|
0
|
|
|
|
|
0
|
|
232
|
|
|
|
|
|
|
} |
233
|
0
|
0
|
|
|
|
0
|
if( $self->{'_statsfilter'} ) { |
234
|
0
|
|
|
|
|
0
|
push @statements, @{$self->_apply_filter($self->{'_statsfilter'}, 'Stats')}; |
|
0
|
|
|
|
|
0
|
|
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
0
|
unshift @statements, sprintf("GET %s", $self->{'_table'}); |
238
|
|
|
|
|
|
|
|
239
|
0
|
0
|
|
|
|
0
|
printf STDERR "EXEC: %s\n", join("\nEXEC: ",@statements) if $TRACE >= 1; |
240
|
|
|
|
|
|
|
|
241
|
0
|
|
|
|
|
0
|
my $statement = join("\n",@statements); |
242
|
0
|
|
|
|
|
0
|
my $options = $self->{'_options'}; |
243
|
0
|
|
|
|
|
0
|
$options->{'slice'} = {}; |
244
|
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
0
|
my $return = $self->{'_class'}->selectall_arrayref($statement, $options); |
246
|
|
|
|
|
|
|
|
247
|
0
|
0
|
|
|
|
0
|
return wantarray ? @{ $return } : $return; |
|
0
|
|
|
|
|
0
|
|
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
################################################################################ |
251
|
|
|
|
|
|
|
sub _apply_filter { |
252
|
31
|
|
|
31
|
|
24373
|
my($self, $filter, $mode) = @_; |
253
|
|
|
|
|
|
|
|
254
|
31
|
|
100
|
|
|
141
|
$compining_prefix = $mode || ''; |
255
|
31
|
|
100
|
|
|
130
|
$filter_mode = $mode || 'Filter'; |
256
|
31
|
|
|
|
|
72
|
my( $combining_count, @statements) = &_recurse_cond($filter); |
257
|
31
|
50
|
|
|
|
138
|
return wantarray ? @statements: \@statements; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
################################################################################ |
261
|
|
|
|
|
|
|
sub _recurse_cond { |
262
|
144
|
|
|
144
|
|
189
|
my($cond, $combining_count) = @_; |
263
|
144
|
|
100
|
|
|
423
|
$combining_count = $combining_count || 0; |
264
|
144
|
50
|
|
|
|
271
|
print STDERR "#IN _recurse_cond $cond $combining_count\n" if $TRACE > 9; |
265
|
144
|
|
|
|
|
244
|
my $method = &_METHOD_FOR_refkind("_cond", $cond); |
266
|
144
|
|
|
|
|
181
|
my ( $child_combining_count, @statment ) = &{\&$method}($cond,$combining_count); |
|
144
|
|
|
|
|
510
|
|
267
|
144
|
|
|
|
|
202
|
$combining_count = $child_combining_count; |
268
|
144
|
50
|
|
|
|
256
|
print STDERR "#OUT _recurse_cond $cond $combining_count ( $method )\n" if $TRACE > 9; |
269
|
144
|
|
|
|
|
496
|
return ( $combining_count, @statment ); |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
################################################################################ |
273
|
0
|
|
|
0
|
|
0
|
sub _cond_UNDEF { return ( () ); } |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
################################################################################ |
276
|
|
|
|
|
|
|
sub _cond_ARRAYREF { |
277
|
37
|
|
|
37
|
|
51
|
my($conds, $combining_count) = @_; |
278
|
37
|
|
100
|
|
|
131
|
$combining_count = $combining_count || 0; |
279
|
37
|
50
|
|
|
|
78
|
print STDERR "#IN _cond_ARRAYREF $conds $combining_count\n" if $TRACE > 9; |
280
|
37
|
|
|
|
|
51
|
my @statment = (); |
281
|
|
|
|
|
|
|
|
282
|
37
|
|
|
|
|
39
|
my $child_combining_count = 0; |
283
|
37
|
|
|
|
|
68
|
my @child_statment = (); |
284
|
37
|
|
|
|
|
42
|
my @cp_conds = @{ $conds }; # work with a copy |
|
37
|
|
|
|
|
103
|
|
285
|
37
|
|
|
|
|
99
|
while ( my $cond = shift @cp_conds ){ |
286
|
|
|
|
|
|
|
my ( $child_combining_count, @child_statment ) = &_dispatch_refkind($cond, { |
287
|
3
|
|
|
3
|
|
22
|
ARRAYREF => sub { &_recurse_cond($cond, $combining_count) }, |
288
|
13
|
|
|
13
|
|
41
|
HASHREF => sub { &_recurse_cond($cond, $combining_count) }, |
289
|
0
|
|
|
0
|
|
0
|
UNDEF => sub { croak "not supported : UNDEF in arrayref" }, |
290
|
68
|
|
|
68
|
|
294
|
SCALAR => sub { &_recurse_cond( { $cond => shift(@cp_conds) } , $combining_count ) }, |
291
|
84
|
|
|
|
|
781
|
}); |
292
|
84
|
|
|
|
|
596
|
push @statment, @child_statment; |
293
|
84
|
|
|
|
|
281
|
$combining_count = $child_combining_count; |
294
|
|
|
|
|
|
|
} |
295
|
37
|
50
|
|
|
|
69
|
print STDERR "#OUT _cond_ARRAYREF $conds $combining_count\n" if $TRACE > 9 ; |
296
|
37
|
|
|
|
|
155
|
return ( $combining_count, @statment ); |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
################################################################################ |
300
|
|
|
|
|
|
|
sub _cond_HASHREF { |
301
|
107
|
|
|
107
|
|
130
|
my($cond, $combining_count) = @_; |
302
|
107
|
|
100
|
|
|
293
|
$combining_count = $combining_count || 0; |
303
|
107
|
50
|
|
|
|
207
|
print STDERR "#IN _cond_HASHREF $cond $combining_count\n" if $TRACE > 9 ; |
304
|
107
|
|
|
|
|
145
|
my @all_statment = (); |
305
|
107
|
|
|
|
|
109
|
my $child_combining_count = 0; |
306
|
107
|
|
|
|
|
120
|
my @child_statment = (); |
307
|
|
|
|
|
|
|
|
308
|
107
|
|
|
|
|
107
|
foreach my $key ( keys %{ $cond } ){ |
|
107
|
|
|
|
|
311
|
|
309
|
107
|
|
|
|
|
149
|
my $value = $cond->{$key}; |
310
|
107
|
|
|
|
|
102
|
my $method ; |
311
|
|
|
|
|
|
|
|
312
|
107
|
100
|
|
|
|
265
|
if ( $key =~ /^-/mxo ){ |
313
|
|
|
|
|
|
|
# Child key for combining filters ( -and / -or ) |
314
|
22
|
|
|
|
|
74
|
( $child_combining_count, @child_statment ) = &_cond_op_in_hash($key, $value, $combining_count); |
315
|
22
|
|
|
|
|
47
|
$combining_count = $child_combining_count; |
316
|
|
|
|
|
|
|
} else{ |
317
|
85
|
|
|
|
|
145
|
$method = &_METHOD_FOR_refkind("_cond_hashpair",$value); |
318
|
85
|
|
|
|
|
121
|
( $child_combining_count, @child_statment ) = &{\&$method}($key, $value, undef ,$combining_count); |
|
85
|
|
|
|
|
229
|
|
319
|
85
|
|
|
|
|
134
|
$combining_count = $child_combining_count; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
107
|
|
|
|
|
284
|
push @all_statment, @child_statment; |
323
|
|
|
|
|
|
|
} |
324
|
107
|
50
|
|
|
|
258
|
print STDERR "#OUT _cond_HASHREF $cond $combining_count\n" if $TRACE > 9; |
325
|
107
|
|
|
|
|
311
|
return ( $combining_count, @all_statment ); |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
################################################################################ |
329
|
|
|
|
|
|
|
sub _cond_hashpair_UNDEF { |
330
|
2
|
|
50
|
2
|
|
5
|
my $key = shift || ''; |
331
|
2
|
|
|
|
|
4
|
my $value = shift; |
332
|
2
|
|
50
|
|
|
81
|
my $operator = shift || '='; |
333
|
2
|
50
|
|
|
|
6
|
print STDERR "# _cond_hashpair_UNDEF\n" if $TRACE > 9 ; |
334
|
|
|
|
|
|
|
|
335
|
2
|
|
50
|
|
|
9
|
my $combining_count = shift || 0; |
336
|
2
|
|
|
|
|
9
|
my @statment = ( |
337
|
|
|
|
|
|
|
sprintf("%s: %s %s",$filter_mode,$key,$operator) |
338
|
|
|
|
|
|
|
); |
339
|
2
|
|
|
|
|
3
|
$combining_count++; |
340
|
2
|
|
|
|
|
6
|
return ( $combining_count, @statment ); |
341
|
|
|
|
|
|
|
}; |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
################################################################################ |
344
|
|
|
|
|
|
|
sub _cond_hashpair_SCALAR { |
345
|
55
|
|
50
|
55
|
|
130
|
my $key = shift || ''; |
346
|
55
|
|
|
|
|
60
|
my $value = shift; |
347
|
55
|
|
100
|
|
|
158
|
my $operator = shift || '='; |
348
|
55
|
50
|
|
|
|
112
|
print STDERR "# _cond_hashpair_SCALAR\n" if $TRACE > 9 ; |
349
|
|
|
|
|
|
|
|
350
|
55
|
|
100
|
|
|
163
|
my $combining_count = shift || 0; |
351
|
55
|
|
|
|
|
177
|
my @statment = ( |
352
|
|
|
|
|
|
|
sprintf("%s: %s %s %s",$filter_mode,$key,$operator,$value) |
353
|
|
|
|
|
|
|
); |
354
|
55
|
|
|
|
|
63
|
$combining_count++; |
355
|
55
|
|
|
|
|
183
|
return ( $combining_count, @statment ); |
356
|
|
|
|
|
|
|
}; |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
################################################################################ |
359
|
|
|
|
|
|
|
sub _cond_hashpair_ARRAYREF { |
360
|
19
|
|
50
|
19
|
|
49
|
my $key = shift || ''; |
361
|
19
|
|
50
|
|
|
45
|
my $values = shift || []; |
362
|
19
|
|
100
|
|
|
59
|
my $operator = shift || '='; |
363
|
19
|
|
100
|
|
|
60
|
my $combining_count = shift || 0; |
364
|
19
|
50
|
|
|
|
48
|
print STDERR "#IN _cond_hashpair_ARRAYREF $combining_count\n" if $TRACE > 9; |
365
|
|
|
|
|
|
|
|
366
|
19
|
|
|
|
|
22
|
my @statment = (); |
367
|
19
|
|
|
|
|
25
|
foreach my $value ( @{ $values }){ |
|
19
|
|
|
|
|
39
|
|
368
|
40
|
|
|
|
|
105
|
push @statment, sprintf("%s: %s %s %s",$filter_mode,$key,$operator,$value); |
369
|
40
|
|
|
|
|
76
|
$combining_count++; |
370
|
|
|
|
|
|
|
} |
371
|
19
|
50
|
|
|
|
53
|
print STDERR "#OUT _cond_hashpair_ARRAYREF $combining_count\n" if $TRACE > 9; |
372
|
19
|
|
|
|
|
71
|
return ( $combining_count, @statment ); |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
################################################################################ |
376
|
|
|
|
|
|
|
sub _cond_hashpair_HASHREF { |
377
|
37
|
|
50
|
37
|
|
79
|
my $key = shift || ''; |
378
|
37
|
|
50
|
|
|
99
|
my $values = shift || {}; |
379
|
37
|
|
50
|
|
|
135
|
my $combining = shift || undef; |
380
|
37
|
|
100
|
|
|
128
|
my $combining_count = shift || 0; |
381
|
|
|
|
|
|
|
|
382
|
37
|
50
|
|
|
|
81
|
print STDERR "#IN Abstract::_cond_hashpair_HASHREF $combining_count\n" if $TRACE > 9; |
383
|
37
|
|
|
|
|
54
|
my @statment = (); |
384
|
|
|
|
|
|
|
|
385
|
37
|
|
|
|
|
48
|
foreach my $child_key ( keys %{ $values } ){ |
|
37
|
|
|
|
|
111
|
|
386
|
37
|
|
|
|
|
59
|
my $child_value = $values->{ $child_key }; |
387
|
|
|
|
|
|
|
|
388
|
37
|
100
|
|
|
|
154
|
if ( $child_key =~ /^-/mxo ){ |
|
|
50
|
|
|
|
|
|
389
|
9
|
|
|
|
|
27
|
my ( $child_combining_count, @child_statment ) = &_cond_op_in_hash($child_key, { $key => $child_value } , 0); |
390
|
9
|
|
|
|
|
20
|
$combining_count += $child_combining_count; |
391
|
9
|
|
|
|
|
28
|
push @statment, @child_statment; |
392
|
|
|
|
|
|
|
} elsif ( $child_key =~ /^[!<>=~]/mxo ){ |
393
|
|
|
|
|
|
|
# Child key is a operator like: |
394
|
|
|
|
|
|
|
# = equality |
395
|
|
|
|
|
|
|
# ~ match regular expression (substring match) |
396
|
|
|
|
|
|
|
# =~ equality ignoring case |
397
|
|
|
|
|
|
|
# ~~ regular expression ignoring case |
398
|
|
|
|
|
|
|
# < less than |
399
|
|
|
|
|
|
|
# > greater than |
400
|
|
|
|
|
|
|
# <= less or equal |
401
|
|
|
|
|
|
|
# >= greater or equal |
402
|
28
|
|
|
|
|
55
|
my $method = &_METHOD_FOR_refkind("_cond_hashpair",$child_value); |
403
|
28
|
|
|
|
|
42
|
my ( $child_combining_count, @child_statment ) = &{\&$method}($key, $child_value,$child_key); |
|
28
|
|
|
|
|
80
|
|
404
|
28
|
|
|
|
|
40
|
$combining_count += $child_combining_count; |
405
|
28
|
|
|
|
|
92
|
push @statment, @child_statment; |
406
|
|
|
|
|
|
|
} else { |
407
|
0
|
|
|
|
|
0
|
my $method = &_METHOD_FOR_refkind("_cond_hashpair",$child_value); |
408
|
0
|
|
|
|
|
0
|
my ( $child_combining_count, @child_statment ) = &{\&$method}($key, $child_value); |
|
0
|
|
|
|
|
0
|
|
409
|
0
|
|
|
|
|
0
|
$combining_count += $child_combining_count; |
410
|
0
|
|
|
|
|
0
|
push @statment, @child_statment; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
} |
413
|
37
|
50
|
|
|
|
95
|
print STDERR "#OUT Abstract::_cond_hashpair_HASHREF $combining_count\n" if $TRACE > 9; |
414
|
37
|
|
|
|
|
133
|
return ( $combining_count, @statment ); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
################################################################################ |
418
|
|
|
|
|
|
|
sub _cond_op_in_hash { |
419
|
31
|
|
|
31
|
|
42
|
my $operator = shift; |
420
|
31
|
|
|
|
|
34
|
my $value = shift; |
421
|
31
|
|
|
|
|
34
|
my $combining_count = shift; |
422
|
31
|
50
|
|
|
|
64
|
print STDERR "#IN _cond_op_in_hash $operator $value $combining_count\n" if $TRACE > 9; |
423
|
|
|
|
|
|
|
|
424
|
31
|
50
|
33
|
|
|
163
|
if ( defined $operator and $operator =~ /^-/mxo ){ |
425
|
31
|
|
|
|
|
82
|
$operator =~ s/^-//mxo; # remove - |
426
|
31
|
|
|
|
|
165
|
$operator =~ s/^\s+|\s+$//gmxo; # remove leading/trailing space |
427
|
31
|
50
|
|
|
|
69
|
$operator = 'GroupBy' if ( $operator eq 'Groupby' ); |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
31
|
|
|
|
|
408
|
my $operators = [{ |
431
|
|
|
|
|
|
|
regexp => qr/(and|or)/mix, |
432
|
|
|
|
|
|
|
handler => '_cond_compining', |
433
|
|
|
|
|
|
|
}, { |
434
|
|
|
|
|
|
|
regexp => qr/(groupby)/mix, |
435
|
|
|
|
|
|
|
handler => '_cond_op_groupby', |
436
|
|
|
|
|
|
|
}, { |
437
|
|
|
|
|
|
|
regexp => qr/(sum|min|max|avg|std)/mix, |
438
|
|
|
|
|
|
|
handler => '_cond_op_simple' |
439
|
|
|
|
|
|
|
}, { |
440
|
|
|
|
|
|
|
regexp => qr/(isa)/mix, |
441
|
|
|
|
|
|
|
handler => '_cond_op_isa' |
442
|
|
|
|
|
|
|
}]; |
443
|
31
|
|
|
58
|
|
109
|
my $operator_config = first { $operator =~ $_->{'regexp'} } @{ $operators }; |
|
58
|
|
|
|
|
338
|
|
|
31
|
|
|
|
|
133
|
|
444
|
31
|
|
|
|
|
97
|
my $operator_handler = $operator_config->{handler}; |
445
|
31
|
50
|
|
|
|
61
|
if ( not ref $operator_handler ){ |
|
|
0
|
|
|
|
|
|
446
|
31
|
|
|
|
|
35
|
return &{\&$operator_handler}($operator,$value,$combining_count); |
|
31
|
|
|
|
|
93
|
|
447
|
|
|
|
|
|
|
}elsif ( ref $operator_handler eq 'CODE' ) { |
448
|
0
|
|
|
|
|
0
|
return $operator_handler->($operator,$value,$combining_count); |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
|
451
|
0
|
0
|
|
|
|
0
|
print STDERR "#OUT _cond_op_in_hash $operator $value $combining_count\n" if $TRACE > 9; |
452
|
0
|
|
|
|
|
0
|
return ( 0, () ); |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
################################################################################ |
456
|
|
|
|
|
|
|
sub _cond_compining { |
457
|
21
|
|
|
21
|
|
28
|
my $combining = shift; |
458
|
21
|
|
|
|
|
41
|
my $value = shift; |
459
|
21
|
|
100
|
|
|
78
|
my $combining_count = shift || 0; |
460
|
21
|
50
|
|
|
|
44
|
print STDERR "#IN _cond_compining $combining $combining_count\n" if $TRACE > 9; |
461
|
21
|
|
|
|
|
25
|
$combining_count++; |
462
|
21
|
|
|
|
|
32
|
my @statment = (); |
463
|
|
|
|
|
|
|
|
464
|
21
|
50
|
33
|
|
|
118
|
if ( defined $combining and $combining =~ /^-/mxo ){ |
465
|
0
|
|
|
|
|
0
|
$combining =~ s/^-//mxo; # remove - |
466
|
0
|
|
|
|
|
0
|
$combining =~ s/^\s+|\s+$//gmxo; # remove leading/trailing space |
467
|
0
|
|
|
|
|
0
|
$combining = ucfirst( $combining ); |
468
|
|
|
|
|
|
|
} |
469
|
21
|
|
|
|
|
50
|
my ( $child_combining_count, @child_statment )= &_recurse_cond($value, 0 ); |
470
|
21
|
|
|
|
|
44
|
push @statment, @child_statment; |
471
|
21
|
50
|
|
|
|
53
|
if ( defined $combining ) { |
472
|
21
|
|
|
|
|
75
|
push @statment, sprintf("%s%s: %d", |
473
|
|
|
|
|
|
|
$compining_prefix, |
474
|
|
|
|
|
|
|
ucfirst( $combining ), |
475
|
|
|
|
|
|
|
$child_combining_count, |
476
|
|
|
|
|
|
|
); |
477
|
|
|
|
|
|
|
} |
478
|
21
|
50
|
|
|
|
46
|
print STDERR "#OUT _cond_compining $combining $combining_count \n" if $TRACE > 9; |
479
|
21
|
|
|
|
|
185
|
return ( $combining_count, @statment ); |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
################################################################################ |
483
|
|
|
|
|
|
|
sub _refkind { |
484
|
351
|
|
|
351
|
|
396
|
my ($data) = @_; |
485
|
351
|
|
|
|
|
356
|
my $suffix = ''; |
486
|
351
|
|
|
|
|
325
|
my $ref; |
487
|
351
|
|
|
|
|
359
|
my $n_steps = 0; |
488
|
|
|
|
|
|
|
|
489
|
351
|
|
|
|
|
346
|
while (1) { |
490
|
|
|
|
|
|
|
# blessed objects are treated like scalars |
491
|
351
|
50
|
|
|
|
931
|
$ref = (blessed $data) ? '' : ref $data; |
492
|
351
|
100
|
|
|
|
684
|
$n_steps += 1 if $ref; |
493
|
351
|
50
|
|
|
|
704
|
last if $ref ne 'REF'; |
494
|
0
|
|
|
|
|
0
|
$data = $$data; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
351
|
|
66
|
|
|
831
|
my $base = $ref || (defined $data ? 'SCALAR' : 'UNDEF'); |
498
|
|
|
|
|
|
|
|
499
|
351
|
|
|
|
|
992
|
return $base . ('REF' x $n_steps); |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
################################################################################ |
503
|
|
|
|
|
|
|
sub _dispatch_refkind { |
504
|
94
|
|
|
94
|
|
157
|
my $value = shift; |
505
|
94
|
|
|
|
|
102
|
my $dispatch_table = shift; |
506
|
|
|
|
|
|
|
|
507
|
94
|
|
|
|
|
149
|
my $type = &_refkind($value); |
508
|
94
|
|
|
|
|
162
|
my $coderef = $dispatch_table->{$type}; |
509
|
|
|
|
|
|
|
|
510
|
94
|
50
|
|
|
|
228
|
die sprintf("No coderef for %s ( %s ) found!",$value, $type) |
511
|
|
|
|
|
|
|
unless ( ref $coderef eq 'CODE' ); |
512
|
|
|
|
|
|
|
|
513
|
94
|
|
|
|
|
157
|
return $coderef->(); |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
################################################################################ |
517
|
|
|
|
|
|
|
sub _METHOD_FOR_refkind { |
518
|
257
|
|
50
|
257
|
|
665
|
my $prefix = shift || ''; |
519
|
257
|
|
|
|
|
271
|
my $value = shift; |
520
|
257
|
|
|
|
|
393
|
my $type = &_refkind($value); |
521
|
257
|
|
|
|
|
612
|
my $method = sprintf("%s_%s",$prefix,$type); |
522
|
257
|
|
|
|
|
517
|
return $method; |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
################################################################################ |
526
|
|
|
|
|
|
|
sub _cond_op_groupby { |
527
|
1
|
|
|
1
|
|
1
|
my $operator = shift; |
528
|
1
|
|
|
|
|
2
|
my $value = shift; |
529
|
1
|
|
50
|
|
|
3
|
my $combining_count = shift || 0; |
530
|
|
|
|
|
|
|
|
531
|
1
|
50
|
|
|
|
4
|
print STDERR "#IN _cond_op_groupby $operator $value $combining_count\n" if $TRACE > 9; |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
my ( @child_statment ) = &_dispatch_refkind($value, { |
534
|
|
|
|
|
|
|
SCALAR => sub { |
535
|
1
|
|
|
1
|
|
4
|
return ( sprintf("%s%s: %s", $compining_prefix, 'GroupBy', $value) ); |
536
|
|
|
|
|
|
|
}, |
537
|
1
|
|
|
|
|
6
|
}); |
538
|
1
|
50
|
|
|
|
6
|
print STDERR "#OUT _cond_op_groupby $operator $value $combining_count\n" if $TRACE > 9; |
539
|
1
|
|
|
|
|
7
|
return ( $combining_count, @child_statment ); |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
################################################################################ |
543
|
|
|
|
|
|
|
sub _cond_op_simple { |
544
|
1
|
|
|
1
|
|
2
|
my $operator = shift; |
545
|
1
|
|
|
|
|
34
|
my $value = shift; |
546
|
1
|
|
50
|
|
|
7
|
my $combining_count = shift || 0; |
547
|
1
|
|
|
|
|
2
|
my @child_statment = (); |
548
|
|
|
|
|
|
|
|
549
|
1
|
50
|
|
|
|
4
|
print STDERR "#IN _cond_op_simple $operator $value $combining_count\n" if $TRACE > 9; |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
( $combining_count,@child_statment ) = &_dispatch_refkind($value, { |
552
|
|
|
|
|
|
|
SCALAR => sub { |
553
|
1
|
|
|
1
|
|
5
|
return (++$combining_count, sprintf("%s: %s %s",$compining_prefix,$operator,$value) ); |
554
|
|
|
|
|
|
|
}, |
555
|
1
|
|
|
|
|
6
|
}); |
556
|
|
|
|
|
|
|
|
557
|
1
|
50
|
|
|
|
7
|
print STDERR "#OUT _cond_op_simple $operator $value $combining_count\n" if $TRACE > 9; |
558
|
1
|
|
|
|
|
6
|
return ( $combining_count, @child_statment ); |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
################################################################################ |
562
|
|
|
|
|
|
|
sub _cond_op_isa { |
563
|
8
|
|
|
8
|
|
8
|
my $operator = shift; |
564
|
8
|
|
|
|
|
9
|
my $value = shift; |
565
|
8
|
|
50
|
|
|
29
|
my $combining_count = shift || 0; |
566
|
8
|
|
|
|
|
7
|
my $as_name; |
567
|
8
|
50
|
|
|
|
15
|
print STDERR "#IN _cond_op_isa $operator $value $combining_count\n" if $TRACE > 9; |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
my ( $child_combining_count, @statment ) = &_dispatch_refkind($value, { |
570
|
|
|
|
|
|
|
HASHREF => sub { |
571
|
8
|
|
|
8
|
|
20
|
my @keys = keys %$value; |
572
|
8
|
50
|
|
|
|
22
|
if ( scalar @keys != 1 ){ |
573
|
0
|
|
|
|
|
0
|
die "Isa operator doesn't support more then one key."; |
574
|
|
|
|
|
|
|
} |
575
|
8
|
|
|
|
|
9
|
$as_name = shift @keys; |
576
|
8
|
|
|
|
|
21
|
my @values = values(%$value); |
577
|
8
|
|
|
|
|
24
|
return &_recurse_cond(shift( @values ), 0 ); |
578
|
|
|
|
|
|
|
}, |
579
|
8
|
|
|
|
|
42
|
}); |
580
|
8
|
|
|
|
|
35
|
$combining_count += $child_combining_count; |
581
|
|
|
|
|
|
|
|
582
|
8
|
|
|
|
|
21
|
$statment[ $#statment ] = $statment[$#statment] . " as " . $as_name; |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
#print STDERR "#OUT _cond_op_isa $operator $value $combining_count isa key: " . $self->{_isa_key} . "\n" if $TRACE > 9; |
585
|
8
|
|
|
|
|
78
|
return ( $combining_count, @statment ); |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
################################################################################ |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
1; |
591
|
|
|
|
|
|
|
__END__ |