File Coverage

blib/lib/Bot/BasicBot/Pluggable/Module/Notify.pm
Criterion Covered Total %
statement 18 112 16.0
branch 0 58 0.0
condition 0 26 0.0
subroutine 6 13 46.1
pod 3 3 100.0
total 27 212 12.7


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