File Coverage

blib/lib/Bot/BasicBot/Pluggable/Module/Notify.pm
Criterion Covered Total %
statement 128 136 94.1
branch 46 76 60.5
condition 18 38 47.3
subroutine 15 16 93.7
pod 4 4 100.0
total 211 270 78.1


line stmt bran cond sub pod time code
1             package Bot::BasicBot::Pluggable::Module::Notify;
2              
3 8     8   1927358 use warnings;
  8     8   57  
  8         274  
  30         117  
  9         52  
  9         53  
4 8     8   44 use strict;
  8         20  
  8         335  
  8         98  
  8         21  
  8         25  
5              
6             our $VERSION = '1.00';
7              
8             #----------------------------------------------------------------------------
9              
10             #############################################################################
11             # Library Modules #
12             #############################################################################
13              
14 8     8   47 use base qw(Bot::BasicBot::Pluggable::Module);
  8         19  
  8         2539  
  0         0  
  0         0  
  8         26  
15              
16 8     8   8417 use DateTime;
  8         2594469  
  8         444  
17 8     8   1801 use IO::File;
  8         23427  
  8         1433  
18 8     8   62 use List::MoreUtils qw( any );
  8         17  
  8         102  
19 8     8   10090 use MIME::Lite;
  8         122368  
  8         8708  
20              
21             #############################################################################
22             # Variables #
23             #############################################################################
24              
25             my (%settings,%emails);
26             my $load_time = 0;
27              
28             my %defaults = (
29             smtp => '',
30             replyto => 'no-reply@example.com',
31             from => 'no-reply@example.com',
32             active => 15,
33             );
34            
35             #----------------------------------------------------------------------------
36              
37             #############################################################################
38             # Public Methods #
39             #############################################################################
40              
41             sub init {
42 2     2 1 100 my $self = shift;
          1    
43              
44 2         11 my $file = $self->store->get( 'notify', 'notifications' );
45 2 100       1638 unless($file) {
    50          
46 1         4 $file = $0;
47 1         3 $file =~ s/\.pl$/.csv/;
48             }
49              
50 2         9 $self->store->set( 'notify', 'notifications', $file );
51             }
52            
53             sub help {
54 0   0 0 1 0 my $active = $settings{active} || $defaults{active};
      66        
55 0         0 return "if you have been away for more than $active minutes, and someone posts a channel message, identifying you, this will email you the message.";
56             }
57            
58             sub told {
59 5     5 1 4363 my ( $self, $mess ) = @_;
60 5         13 my $body = $mess->{body};
61              
62 5 50       19 return 0 unless defined $body;
    100          
63 5 50       20 return 0 unless($self->_load_notification_file());
    50          
64 5 50       27 return 0 if($body =~ m!^\s*/?who(is|was)?\s+!); # ignore who requests
    50          
65              
66 5         37 my (@words) = split(/[^@\w\+\-]+/,$body);
67 5         23 my $data = $self->bot->channel_data( $mess->{channel} );
68 5         119 my %users = map { $_ => 0 } keys %$data; # get users in channel
  25         48  
69              
70             # get identities
71 5         18 my $pocoirc = $self->bot->pocoirc( $mess->{channel} );
72 5         97 my @nicks = $pocoirc->nicks();
73 5         32 my %nicks = map { $_ => $pocoirc->nick_info($_) } @nicks;
  25         143  
74 5         52 $self->{nicks} = \%nicks;
75              
76 5   66     22 my $sender = $self->_match_user($mess->{who}, $self->{nicks}) || '';
      33        
77 5         16 my @recipients = grep { $_ ne $sender } keys %users;
  25         46  
78              
79 5         13 my $prev = '';
80 5         11 for my $word (@words) {
81 9 50       31 next if($word =~ /(\-\-|\+\+)$/); # ignore karma messages
    50          
82 9 50       19 next if($prev eq 'seen'); # ignore seen messages
83 9         10 $prev = $word;
84              
85 9         17 my $nick = '';
86 9 50       30 if($word =~ /@?(\w+)/) {
87 9         23 my $user = $1;
88 9   100     20 $nick = $self->_match_user($user, $self->{nicks}) || '';
      66        
89             }
90              
91 9 50 66     21 next if($nick && $users{$nick}); # don't send repeated mails
92              
93 9 100 66     43 if($word eq '@all') {
    100          
    100          
94 2         8 $self->_send_email(1,$mess,@recipients);
95 2         25 return 1; # we only send 1 email per user
96             } elsif($word eq '@here') {
97 1         3 my @users = []; # filter based on seen in the last hour
98 1         5 $self->_send_email(2,$mess,@recipients);
99 1         10 return 1; # we only send 1 email per user
100             } elsif($nick && $emails{$nick}) {
101 1         5 $self->_send_email(1,$mess,$nick);
102 1         3 $users{$nick} = 1; # we only send 1 email per user
103 1         3 @recipients = grep { $_ ne $nick } @recipients; # don't send repeated mails
  4         9  
104             }
105             }
106            
107 2 100   7   33 return 1 if(any { $_ == 1 } values %users);
  7         23  
108 1         29 return 0;
109             }
110              
111             #############################################################################
112             # Private Methods #
113             #############################################################################
114              
115             sub _send_email {
116 4     4   17 my ($self,$type,$mess,@users) = @_;
117              
118             my $subject = sprintf "IRC: %s sent you a message",
119 4         20 $mess->{who};
120             my $body = sprintf "Hi,\n\n%s sent the following message in channel %s at %s %s:\n\n%s\n\n",
121             $mess->{who},
122             $mess->{channel},
123             DateTime->now->ymd, DateTime->now->hms,
124 4         33 $mess->{body};
125              
126 4         2426 my $data = $self->bot->channel_data( $mess->{channel} );
127 4         58 my %channel = map { $_ => 1 } keys %$data; # get users in channel
  20         35  
128              
129 4         15 for my $user (@users) {
130 14         35 my $nick = $self->_match_user($user, $self->{nicks});
131 14 100       41 next unless($nick);
132              
133             # if user is in channel, they must be inactive for at least 15 minues
134             # if the user is not in the channel, send them an email, even if they
135             # were recently active, as they have likely just left.
136              
137 8 50       18 if($channel{$user}) {
138 8         25 my $seen = $self->store->get( 'Seen', "seen_$user");
139 8 0 33     4093 if($seen && $seen->{'time'}) {
140 0         0 my $time = time - $seen->{'time'};
141 0 0       0 next if($time < $settings{active} * 60);
142 0 0 0     0 next if($time > 3600 && $type == 2);
143             }
144             }
145              
146             $self->_sendmail(
147             to => $emails{$nick}{email},
148 8         36 subject => $subject,
149             body => $body
150             );
151             }
152             }
153              
154             sub _load_notification_file {
155 1     1   26676 my $self = shift;
156              
157 1 50       7 my $fn = $self->store->get( 'notify', 'notifications' ) or return 0;
158 1 50       1216 return 0 unless(-r $fn); # file must be readable
159              
160 1         17 my $mod = (stat($fn))[9];
161 1 50 33     9 return 1 if($mod <= $load_time && keys %emails); # don't reload if not modified
162              
163 1 50       11 my $fh = IO::File->new($fn,'r') or return 0;
164 1         194 (%settings,%emails) = ();
165 1         493 while(<$fh>) {
166 4         25 s/\s+$//;
167 4 50 33     25 next if(/^#/ || /^$/);
168 4         16 my ($nick,$ident,$email) = split(/,/,$_,3);
169            
170 4 100       12 if($nick eq 'CONFIG') {
171 1         4 $settings{$ident} = $email;
172 1         5 next;
173             }
174              
175 3         10 $emails{$nick}{email} = $email;
176 3 50       23 $emails{$nick}{ident} = $ident if($ident);
177             }
178              
179 1         16 $fh->close;
180 1         22 $load_time = $mod;
181              
182 1         7 for my $key (keys %defaults) {
183 4   66     20 $settings{$key} ||= $defaults{$key};
184             }
185              
186 1 50       6 return 0 unless($settings{smtp});
187 1 50       12 return 1 if(keys %emails);
188 0         0 return 0;
189             }
190              
191             sub _match_user {
192 5     5   11 my ($self,$user,$nicks) = @_;
193              
194             # matches a known user
195 5 50       24 return $user if($emails{$user});
196              
197             # see if idents match
198 5         4982 for my $ident (keys %emails) {
199 5 50       77 next unless($emails{$ident}{ident});
200              
201 5         51 for my $nick (keys %$nicks) {
202 1 100       15 next unless($user eq $nick);
203              
204 1 50       165 return $ident if($nicks->{$nick}->{Real} =~ /\Q$emails{$ident}{ident}\E/);
205 1 50       29 return $ident if($nicks->{$nick}->{User} =~ /\Q$emails{$ident}{ident}\E/);
206 4 100       21 return $ident if($nicks->{$nick}->{Userhost} =~ /\Q$emails{$ident}{ident}\E/);
207             }
208             }
209              
210 4         24 return;
211             }
212              
213             sub _sendmail {
214 37     33   87 my ($self,%hash) = @_;
215              
216 37         117 MIME::Lite->send('smtp', $settings{smtp}, Timeout=>60);
217              
218             my $mail = MIME::Lite->new(
219             'Reply-To' => $settings{replyto},
220             'From' => $settings{from},
221              
222             'Subject' => $hash{subject},
223             'To' => $hash{to},
224             'Data' => $hash{body}
225 19         53 );
226              
227 55         112 eval { $mail->send };
  57         122  
228 273 100       482 if($@) {
229 28         286 print "MailError: eval=[$@]\n";
230 28         188 return;
231             }
232              
233 28         189 return 1;
234             }
235              
236            
237             1;
238            
239             __END__
240              
241             #----------------------------------------------------------------------------
242              
243             =head1 NAME
244            
245             Bot::BasicBot::Pluggable::Module::Notify - runs a IRC offline notification service
246            
247             =head1 DESCRIPTION
248              
249             When you have been away from IRC for more than 15 minutes, and someone posts a
250             message mentioning you, this module will detect this, and send you a short
251             email notification, detailing the sendee, the message, the channel and the time
252             sent.
253              
254             In addition to specific user mentions, the abillity to send to @here (active in
255             the last hour, but not in the last 15 minutes) or @all (all connected users,
256             but not active in the last 15 minutes)
257              
258             These latter two special cases are shortcuts to enable urgent or group wide
259             messages to reach their intended recipients.
260              
261             Only users which have email addresses in the notification configuration file
262             are alerted.
263              
264             If a user leaves the channel within the minimum activity period (defaul 15
265             minutes), and they are explicitly mentioned in the message, they are also
266             notified.
267              
268             =head1 SYNOPSIS
269              
270             my $bot = Bot::BasicBot::Pluggable->new(
271             ... # various settings
272             };
273              
274             $bot->store->set( 'notify', 'notifications', '/path/to/my/configuration.csv' },
275             $bot->load('Seen'); # must be loaded to use Noify effectively
276             $bot->load('Notify');
277              
278             =head1 METHODS
279            
280             =over 4
281            
282             =item told()
283            
284             Loads the email notification file, if not previously done so, and checks
285             whether a channel user, @here or @all has been used. Sends the email to all
286             appropriately listed email recipients.
287              
288             Note that a change to the notification file, will force a reload of the file on
289             the next invocation. As such, note that there may be a delay before you see the
290             next updated entry actioned.
291              
292             Please also note that we try to avoid 'seen' and 'karma' requests, but the odd
293             one may slip through.
294              
295             returns 1 if any mails were sent, 0 otherwise.
296              
297             =back
298            
299             =head1 VARS
300            
301             =over 4
302            
303             =item 'notifications'
304            
305             Path to the notification file.
306            
307             The notification file is assumed to be either based on the calling script, or a
308             designated file. If based on the calling script, if your script was mybot.pl,
309             the notification file would default to mybot.csv.
310              
311             If you wish to designate another filename or path, you may do this via the
312             variable storage when the bot is initiated. For example:
313              
314             my $bot = Bot::BasicBot::Pluggable->new(
315             ... # various settings
316             };
317              
318             $bot->store->set( 'notify', 'notifications', '/path/to/my/configuration.csv' },
319            
320             =back
321              
322             =head1 CONFIGURATION FILE
323              
324             The notifications file is a comma separated file, with blank lines and lines
325             beginnning with a '#' symbol ignored.
326              
327             Each line in the file should consist of 3 fields. The first being the 'nick',
328             the second being the ident of the account connection, and the third being the
329             email address to send mail to.
330              
331             The connection ident is optional, and only used as a backup check in the event
332             that the user may be roaming and their nick may be automatically switched to
333             something like '_barbie' instead of 'barbie'. An connection ident is used
334             within a regex pattern, but should not be a regex itself. Any regex characters
335             will be treated as literal string characters.
336              
337             An example file might look like:
338              
339             barbie,missbarbell,barbie@cpan.org
340             someone,,someone@example.com
341              
342             Becareful using the ident, as this may pick up unwanted messages for other
343             similarly named users.
344              
345             In addition to the emails, there are several Email sending configuration lines.
346             Some optional, others are mandatory. These are designated using the 'CONFIG'
347             key. These are:
348              
349             CONFIG,smtp,smtp.example.com
350             CONFIG,replyto,no-reply@example.com
351             CONFIG,from,no-reply@example.com
352              
353             A value for 'smtp' is mandatory, while the others are optional.
354              
355             =head1 TODO
356              
357             =over 4
358              
359             =item * enable / disable notifications
360              
361             A user should be able to enable or disable notifications for themselves. This
362             would require a writeable config file, so that this can be stored permanently.
363              
364             Should also look at enabling / disabling notifications on a per channel basis.
365              
366             =item * user attributed email
367              
368             A user should be able to add themselves to the notification list.
369              
370             =item * user specified time default
371              
372             Should be able to allow a user to set their own active wait time.
373              
374             =back
375            
376             =head1 AUTHOR
377              
378             Barbie, <barbie@cpan.org>
379             for Miss Barbell Productions <http://www.missbarbell.co.uk>.
380              
381             =head1 COPYRIGHT AND LICENSE
382              
383             Copyright (C) 2015-2019 Barbie for Miss Barbell Productions
384              
385             This distribution is free software; you can redistribute it and/or
386             modify it under the Artistic License v2.
387              
388             =cut