line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::MonM::Notifier::Agent; # $Id: Agent.pm 61 2019-07-14 12:04:03Z abalama $ |
2
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
3
|
1
|
|
|
1
|
|
4
|
use utf8; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=encoding utf-8 |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 NAME |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
App::MonM::Notifier::Agent - App::MonM::Notifier agent |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 VERSION |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Version 1.01 |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
use App::MonM::Notifier::Agent; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $agent = new App::MonM::Notifier::Agent( |
20
|
|
|
|
|
|
|
configobj => $app->configobj, |
21
|
|
|
|
|
|
|
users => [qw/foo bar/], |
22
|
|
|
|
|
|
|
); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 DESCRIPTION |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
This module provides agent methods. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head2 new |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
my $agent = new App::MonM::Notifier::Agent( |
31
|
|
|
|
|
|
|
configobj => $app->configobj, |
32
|
|
|
|
|
|
|
users => [qw/foo bar/], |
33
|
|
|
|
|
|
|
); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=over 4 |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=item B |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
CTK config object |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=item B |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
The list of users |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=back |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head2 config |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
my $configobj = $agent->config; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
Returns CTK config object |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head2 create |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
$agent->create( |
56
|
|
|
|
|
|
|
to => "test", |
57
|
|
|
|
|
|
|
subject => $sbj, |
58
|
|
|
|
|
|
|
message => $msg, |
59
|
|
|
|
|
|
|
) or die($agent->error); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
Creates message and returns status of operation |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head2 error |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my $error = $agent->error; |
66
|
|
|
|
|
|
|
my $status = $agent->error( "error text" ); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
Returns error string if no arguments. |
69
|
|
|
|
|
|
|
Sets error string also sets status to false (if error string is not false) |
70
|
|
|
|
|
|
|
or to true (if error string is false) and returns this status |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head2 status |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
if ($agent->status) { |
75
|
|
|
|
|
|
|
# OK |
76
|
|
|
|
|
|
|
} else { |
77
|
|
|
|
|
|
|
# ERROR |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Returns object's status. 1 - OK, 0 - ERROR |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
my $status = $agent->status( 1 ); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Sets new status and returns it |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head2 store |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
my $store = $agent->store; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
Returns current store object |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head2 trysend |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
$agent->trysend() or die($agent->error); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Tries to send all active messages |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head1 HISTORY |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
See C file |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
L, L |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=head1 TO DO |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
See C file |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head1 BUGS |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
* none noted |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head1 SEE ALSO |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
L |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head1 AUTHOR |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head1 COPYRIGHT |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head1 LICENSE |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
129
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
See C file and L |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut |
134
|
|
|
|
|
|
|
|
135
|
1
|
|
|
1
|
|
35
|
use vars qw/$VERSION/; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
46
|
|
136
|
|
|
|
|
|
|
$VERSION = '1.01'; |
137
|
|
|
|
|
|
|
|
138
|
1
|
|
|
1
|
|
5
|
use File::Spec; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
27
|
|
139
|
1
|
|
|
1
|
|
386
|
use File::HomeDir; |
|
1
|
|
|
|
|
4571
|
|
|
1
|
|
|
|
|
45
|
|
140
|
|
|
|
|
|
|
|
141
|
1
|
|
|
1
|
|
6
|
use CTK::ConfGenUtil; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
142
|
1
|
|
|
1
|
|
5
|
use CTK::TFVals qw/ :ALL /; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
168
|
|
143
|
|
|
|
|
|
|
|
144
|
1
|
|
|
1
|
|
6
|
use App::MonM::Util qw/getExpireOffset/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
36
|
|
145
|
|
|
|
|
|
|
|
146
|
1
|
|
|
1
|
|
5
|
use App::MonM::Notifier::Const qw/ :jobs :functions /; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
100
|
|
147
|
1
|
|
|
1
|
|
387
|
use App::MonM::Notifier::Store; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
29
|
|
148
|
1
|
|
|
1
|
|
6
|
use App::MonM::Notifier::Util qw/checkPubDate/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
149
|
1
|
|
|
1
|
|
373
|
use App::MonM::Notifier::Channel; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
937
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub new { |
152
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
153
|
0
|
|
|
|
|
|
my %opts = @_; |
154
|
0
|
|
0
|
|
|
|
my $configobj = $opts{configobj} || $opts{config}; |
155
|
0
|
|
0
|
|
|
|
my $userreqs = $opts{users} || $opts{user}; |
156
|
0
|
|
0
|
|
|
|
my $notifier_conf = $configobj->conf("notifier") || {}; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# List of required users |
159
|
0
|
|
|
|
|
|
my @ureqs = (); |
160
|
0
|
0
|
0
|
|
|
|
if ($userreqs && ref($userreqs) eq 'ARRAY') { |
|
|
0
|
0
|
|
|
|
|
161
|
0
|
|
|
|
|
|
@ureqs = @$userreqs; |
162
|
|
|
|
|
|
|
} elsif ($userreqs && !ref($userreqs)) { |
163
|
0
|
|
|
|
|
|
push @ureqs, $userreqs; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# Get actual user list |
167
|
0
|
|
0
|
|
|
|
my $user_conf = $configobj->conf('user') || {}; |
168
|
0
|
|
|
|
|
|
my @users = (); |
169
|
0
|
|
|
|
|
|
foreach my $u (keys %$user_conf) { |
170
|
0
|
0
|
|
|
|
|
if (@ureqs) { |
171
|
0
|
0
|
|
|
|
|
next unless grep {$_ eq $u} @ureqs; |
|
0
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
} |
173
|
0
|
|
|
|
|
|
push @users, $u; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# Get expires |
177
|
0
|
|
0
|
|
|
|
my $expires_def = getExpireOffset($configobj->conf("expires") || $configobj->conf("expire") || 0); |
178
|
0
|
|
0
|
|
|
|
my $expires = getExpireOffset(value($notifier_conf, "expires") || value($notifier_conf, "expire")) || $expires_def; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# Get timeout |
181
|
0
|
|
0
|
|
|
|
my $timeout = getExpireOffset(value($notifier_conf, "timeout") || $configobj->conf("timeout") || 0); |
182
|
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
my %props = ( |
184
|
|
|
|
|
|
|
error => '', |
185
|
|
|
|
|
|
|
status => 1, |
186
|
|
|
|
|
|
|
store => undef, |
187
|
|
|
|
|
|
|
config => $configobj, |
188
|
|
|
|
|
|
|
users => [@users], |
189
|
|
|
|
|
|
|
datadir => File::HomeDir->my_data, |
190
|
|
|
|
|
|
|
expires => $expires, |
191
|
|
|
|
|
|
|
timeout => $timeout, |
192
|
|
|
|
|
|
|
); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# DBI object (store) |
195
|
0
|
|
|
|
|
|
my $dbi_file = File::Spec->catfile($props{datadir}, App::MonM::Notifier::Store::DB_FILENAME()); |
196
|
0
|
|
0
|
|
|
|
my $dbi_conf = $notifier_conf->{"dbi"} || {file => $dbi_file}; |
197
|
0
|
0
|
|
|
|
|
$dbi_conf = {file => $dbi_file} unless is_hash($dbi_conf); |
198
|
0
|
|
|
|
|
|
my $store = new App::MonM::Notifier::Store(%$dbi_conf, expires => $expires); |
199
|
0
|
0
|
|
|
|
|
if ($store->status) { |
200
|
0
|
|
|
|
|
|
$props{store} = $store; |
201
|
|
|
|
|
|
|
} else { |
202
|
0
|
|
|
|
|
|
$props{error} = sprintf("Can't create store instance: %s", $store->error); |
203
|
0
|
|
|
|
|
|
$props{status} = 0; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
return bless { %props }, $class; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
sub status { |
209
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
210
|
0
|
|
|
|
|
|
my $value = shift; |
211
|
0
|
0
|
|
|
|
|
return fv2zero($self->{status}) unless defined($value); |
212
|
0
|
0
|
|
|
|
|
$self->{status} = $value ? 1 : 0; |
213
|
0
|
|
|
|
|
|
return $self->{status}; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
sub error { |
216
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
217
|
0
|
|
|
|
|
|
my $value = shift; |
218
|
0
|
0
|
|
|
|
|
return uv2null($self->{error}) unless defined($value); |
219
|
0
|
|
|
|
|
|
$self->{error} = $value; |
220
|
0
|
0
|
|
|
|
|
$self->status($value ne "" ? 0 : 1); |
221
|
0
|
|
|
|
|
|
return $self->status; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
sub store { |
224
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
225
|
0
|
|
|
|
|
|
$self->{store}; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
sub config { |
228
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
229
|
0
|
|
|
|
|
|
$self->{config}; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
sub create { |
232
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
233
|
0
|
|
|
|
|
|
my %in = @_; |
234
|
0
|
|
|
|
|
|
my $store = $self->store; |
235
|
0
|
0
|
0
|
|
|
|
return $self->error("Can't use undefined store object") unless $store && $store->ping; |
236
|
0
|
|
|
|
|
|
$self->error(""); |
237
|
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
my $to = $in{to}; |
239
|
0
|
|
|
|
|
|
my $allowed_users = $self->{users}; |
240
|
0
|
0
|
|
|
|
|
foreach my $u (grep {$to ? ($_ eq $to) : 1} @$allowed_users) { |
|
0
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# Get User node |
242
|
0
|
|
|
|
|
|
my $usernode = node($self->config->conf("user"), $u); |
243
|
0
|
0
|
0
|
|
|
|
next unless is_hash($usernode) && keys %$usernode; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# Get channels |
246
|
0
|
|
|
|
|
|
my $channels = hash($usernode => "channel"); |
247
|
0
|
|
|
|
|
|
foreach my $ch_name (keys %$channels) { |
248
|
|
|
|
|
|
|
# Create new record |
249
|
|
|
|
|
|
|
$store->add( |
250
|
|
|
|
|
|
|
to => $u, |
251
|
|
|
|
|
|
|
channel => $ch_name, |
252
|
|
|
|
|
|
|
subject => $in{subject}, |
253
|
|
|
|
|
|
|
message => $in{message}, |
254
|
0
|
0
|
|
|
|
|
) or do { |
255
|
0
|
|
|
|
|
|
return $self->error($store->error); |
256
|
|
|
|
|
|
|
}; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
0
|
|
|
|
|
|
return 1; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
sub trysend { |
264
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
265
|
0
|
|
|
|
|
|
my $store = $self->store; |
266
|
0
|
0
|
0
|
|
|
|
return $self->error("Can't use undefined store object") unless $store && $store->ping; |
267
|
0
|
|
|
|
|
|
$self->error(""); |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# Channel object |
270
|
0
|
|
|
|
|
|
my $channel = new App::MonM::Notifier::Channel(configobj => $self->config); |
271
|
|
|
|
|
|
|
|
272
|
0
|
|
|
|
|
|
my $allowed_users = $self->{users}; |
273
|
0
|
|
|
|
|
|
foreach my $u (@$allowed_users) { |
274
|
|
|
|
|
|
|
# Get User node |
275
|
0
|
|
|
|
|
|
my $usernode = node($self->config->conf("user"), $u); |
276
|
0
|
0
|
0
|
|
|
|
next unless is_hash($usernode) && keys %$usernode; |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
# Get channels |
279
|
0
|
|
|
|
|
|
my $channels = hash($usernode => "channel"); |
280
|
0
|
|
|
|
|
|
foreach my $ch_name (keys %$channels) { |
281
|
0
|
0
|
|
|
|
|
next unless checkPubDate($usernode, $ch_name); # Skip by period checking |
282
|
0
|
|
|
|
|
|
my $ch = hash($channels, $ch_name); |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# Get data to processing |
285
|
0
|
|
|
|
|
|
my %data = $store->getByName($u, $ch_name); |
286
|
0
|
0
|
|
|
|
|
return $self->error($store->error) unless $store->status; |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# Processing data |
289
|
0
|
|
|
|
|
|
foreach my $rec (values %data) { |
290
|
0
|
0
|
|
|
|
|
if (fv2zero($rec->{expires}) < time()) { # EXPIRED |
291
|
0
|
0
|
|
|
|
|
$store->setStatus($rec->{id}, JOB_EXPIRED) or do { |
292
|
0
|
|
|
|
|
|
return $self->error($store->error); |
293
|
|
|
|
|
|
|
}; |
294
|
|
|
|
|
|
|
} else { # TO SEND |
295
|
0
|
|
|
|
|
|
my $status = $channel->process($rec, $ch); |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# Set result status |
298
|
0
|
0
|
|
|
|
|
if ($status) { # JOB_SENT |
299
|
0
|
0
|
|
|
|
|
$store->setStatus($rec->{id}, JOB_SENT) or do { |
300
|
0
|
|
|
|
|
|
return $self->error($store->error); |
301
|
|
|
|
|
|
|
}; |
302
|
|
|
|
|
|
|
} else { |
303
|
0
|
0
|
|
|
|
|
$store->setError($rec->{id}, 102, $channel->error) or do { |
304
|
0
|
|
|
|
|
|
return $self->error($store->error); |
305
|
|
|
|
|
|
|
}; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
} |
311
|
0
|
|
|
|
|
|
return 1; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
1; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
__END__ |