File Coverage

blib/lib/App/MonM/Notifier/Agent.pm
Criterion Covered Total %
statement 36 122 29.5
branch 0 46 0.0
condition 0 37 0.0
subroutine 12 19 63.1
pod 7 7 100.0
total 55 231 23.8


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__