File Coverage

blib/lib/Bot/IRC/X/Reminder.pm
Criterion Covered Total %
statement 20 71 28.1
branch 0 46 0.0
condition 0 8 0.0
subroutine 6 9 66.6
pod 0 1 0.0
total 26 135 19.2


line stmt bran cond sub pod time code
1             package Bot::IRC::X::Reminder;
2             # ABSTRACT: Bot::IRC plugin for scheduling reminders
3              
4 1     1   330609 use 5.014;
  1         9  
5 1     1   5 use exact;
  1         2  
  1         4  
6              
7 1     1   1411 use DateTime;
  1         366872  
  1         45  
8 1     1   9 use DateTime::Duration;
  1         1  
  1         24  
9 1     1   6 use Time::Crontab;
  1         2  
  1         1377  
10              
11             our $VERSION = '1.05'; # VERSION
12              
13             sub init {
14 1     1 0 6279 my ($bot) = @_;
15 1         7 $bot->load('Store');
16              
17             $bot->hook(
18             {
19             to_me => 1,
20             text => qr/
21             ^remind\s+(?<target>\S+)\s+(?<type>at|in|every)\s+
22             (?<expr>
23             (?:[\d\*\/\,\-]+\s+){4}[\d\*\/\,\-]+|
24             \d{1,2}:\d{2}\s*[ap]m?|
25             (?:\d+:)+\d+|
26             \d{3,4}
27             )
28             \s+(?<text>.+)
29             /ix,
30             },
31             sub {
32 0     0   0 my ( $bot, $in, $m ) = @_;
33              
34 0         0 my $target = lc( $m->{target} );
35 0 0       0 $target = $in->{nick} if ( $target eq 'me' );
36              
37 0         0 my ( $expr, $lapse ) = ( '', 0 );
38 0 0       0 if ( $m->{expr} =~ /^(\d{1,2}):(\d{2})\s*([ap])m?$/i ) {
    0          
    0          
39 0 0       0 $expr = join( ' ', $2, ( ( lc $3 eq 'a' ) ? $1 + 12 : $1 ), '* * *' );
40             }
41             elsif ( $m->{expr} =~ /^(\d{1,2})(\d{2})$/ ) {
42 0         0 $expr = "$2 $1 * * *";
43             }
44             elsif ( $m->{expr} =~ /^(?:\d+:)*\d+$/ ) {
45 0         0 my @parts = split( /:/, $m->{expr} );
46 0         0 shift(@parts) while ( @parts > 6 );
47 0         0 unshift( @parts, 0 ) while ( @parts < 6 );
48              
49             $lapse = DateTime->now->add_duration(
50             DateTime::Duration->new(
51 0         0 map { $_ => shift @parts } qw( years months weeks days hours minutes )
  0         0  
52             )
53             )->epoch - time();
54             }
55             else {
56 0         0 $expr = $m->{expr};
57             }
58              
59 0 0       0 my @reminders = @{ $bot->store->get('reminders') || [] };
  0         0  
60             push( @reminders, {
61             author => lc( $in->{nick} ),
62             target => $target,
63             repeat => ( ( lc( $m->{type} ) eq 'every' ) ? 1 : 0 ),
64             text => $m->{text},
65 0 0       0 expr => $expr,
    0          
66             time => ( ($lapse) ? time() + $lapse : undef ),
67             lapse => $lapse,
68             } );
69 0         0 $bot->store->set( 'reminders' => \@reminders );
70              
71 0         0 $bot->reply_to('OK.');
72             },
73 1         1113 );
74              
75             $bot->tick(
76             '* * * * *',
77             sub {
78 0     0   0 my ($bot) = @_;
79 0 0       0 my @reminders = @{ $bot->store->get('reminders') || [] };
  0         0  
80 0 0       0 return unless (@reminders);
81 0         0 my $reminders_changed = 0;
82              
83 0         0 @reminders = grep { defined } map {
84 0         0 $bot->msg( $_->{target}, $_->{text} );
85 0 0       0 $_->{time} += $_->{lapse} if ( $_->{time} );
86 0 0       0 $reminders_changed = 1 unless ( $_->{repeat} );
87 0 0       0 ( $_->{repeat} ) ? $_ : undef;
88             }
89             grep {
90 0         0 $_->{time} and $_->{time} <= time() or
91 0 0 0     0 $_->{expr} and Time::Crontab->new( $_->{expr} )->match( time() )
      0        
92             } @reminders;
93              
94 0 0       0 $bot->store->set( 'reminders' => \@reminders ) if ($reminders_changed);
95             },
96 1         24 );
97              
98             $bot->hook(
99             {
100             to_me => 1,
101             text => qr/^reminders\s+(?<command>list|forget)\s+(?<scope>mine|all)\b/i,
102             },
103             sub {
104 0     0   0 my ( $bot, $in, $m ) = @_;
105 0 0       0 my @reminders = @{ $bot->store->get('reminders') || [] };
  0         0  
106              
107 0 0       0 if ( lc( $m->{command} ) eq 'list' ) {
108 0 0       0 if ( lc( $m->{scope} ) eq 'mine' ) {
109 0         0 my $me = lc( $in->{nick} );
110 0         0 @reminders = grep { $_->{author} eq $me } @reminders;
  0         0  
111             }
112             $bot->reply_to(
113 0 0       0 'I have no reminders ' . ( ( lc( $m->{scope} ) eq 'mine' ) ? 'from you ' : '' ) . 'on file.'
    0          
114             ) unless (@reminders);
115              
116 0         0 for ( my $i = 0; $i < @reminders; $i++ ) {
117             $bot->reply_to(
118             ( $reminders[$i]->{expr} || scalar( localtime( $reminders[$i]->{time} ) ) ) . ' ' .
119             ( ( $reminders[$i]->{repeat} ) ? '(repeating) ' : '' ) .
120             'to ' . $reminders[$i]->{target} .
121             ': ' . $reminders[$i]->{text}
122 0 0 0     0 );
123 0 0       0 sleep 1 if ( $i + 1 < @reminders );
124             }
125             }
126             else {
127 0 0       0 if ( lc( $m->{scope} ) eq 'mine' ) {
128 0         0 my $me = lc( $in->{nick} );
129 0         0 @reminders = grep { $_->{author} ne $me } @reminders;
  0         0  
130             }
131             else {
132 0         0 @reminders = ();
133             }
134              
135 0         0 $bot->store->set( 'reminders' => \@reminders );
136 0         0 $bot->reply_to('OK.');
137             }
138              
139 0         0 return 1;
140             },
141 1         1131 );
142              
143 1         23 $bot->helps( reminder =>
144             'Set reminders for things. ' .
145             'Usage: <bot nick> remind <nick> <every|at|in> <time expr> <reminder text>. ' .
146             'See also: https://metacpan.org/pod/Bot::IRC::X::Reminder.'
147             );
148             }
149              
150             1;
151              
152             __END__
153              
154             =pod
155              
156             =encoding UTF-8
157              
158             =head1 NAME
159              
160             Bot::IRC::X::Reminder - Bot::IRC plugin for scheduling reminders
161              
162             =head1 VERSION
163              
164             version 1.05
165              
166             =for markdown [![test](https://github.com/gryphonshafer/Bot-IRC-X-Reminder/workflows/test/badge.svg)](https://github.com/gryphonshafer/Bot-IRC-X-Reminder/actions?query=workflow%3Atest)
167             [![codecov](https://codecov.io/gh/gryphonshafer/Bot-IRC-X-Reminder/graph/badge.svg)](https://codecov.io/gh/gryphonshafer/Bot-IRC-X-Reminder)
168              
169             =head1 SYNOPSIS
170              
171             use Bot::IRC;
172              
173             Bot::IRC->new(
174             connect => { server => 'irc.perl.org' },
175             plugins => ['Reminder'],
176             )->run;
177              
178             =head1 DESCRIPTION
179              
180             This L<Bot::IRC> plugin is for scheduling reminders. You can ask the bot to
181             remind someone about something at some future time. If the nick who needs to
182             be reminded isn't online at the time of the reminder, the reminder isn't issued.
183              
184             The general format is:
185              
186             <bot nick> remind <nick|channel> <every|at|in> <time expr> <reminder text>
187              
188             If you specify a "nick" of "me", then the bot will remind your nick.
189              
190             The "every|at|in" is the type of reminder. Each type of reminder requires a
191             slightly different time expression.
192              
193             =head2 at
194              
195             The "at" reminder type requires a time expression in the form of a clock time
196             or a crontab-looking expression. Clock time expressions are in the form
197             C<\d{1,2}:\d{2}\s*[ap]m?> for "normal human time" and C<\d{3,4}> for military
198             time.
199              
200             bot remind me at 2:30p This is to remind you of your dentist appointment.
201             bot remind hoser at 1620 Hey hoser, it's 4:20 PM now.
202             bot remind #team at 0530 Time for someone on the team to make coffee.
203              
204             Crontab-looking expressions are in the C<* * * * *> form.
205              
206             bot remind me at 30 5 * * 1-5 Good morning! It's a great day to code Perl.
207              
208             Once an "at" reminder type triggers, it's done and won't repeat.
209              
210             =head2 in
211              
212             The "in" reminder type requires a number of minutes in the future for when the
213             reminder should happen. In addition to minutes, you can specify hours, days,
214             weeks, or whatever.
215              
216             bot remind me in 30 It has been half-an-hour since you set this reminder.
217             bot remind me in 2:30 It has been 2 hours and 30 minutes.
218             bot remind me in 3:0:0 It has been 3 days.
219             bot remind me in 1:2:0:0 It has been 1 week and 2 days.
220              
221             Once an "in" reminder type triggers, it's done and won't repeat.
222              
223             =head2 every
224              
225             The "every" reminder type is exactly like the "at" reminder type except that
226             the reminder repeatedly triggers when the time expression matches.
227              
228             bot remind me every 30 5 * * 1-5 Another great day to code Perl.
229              
230             =head1 HELPER FUNCTIONS
231              
232             There are a couple of helper functions you can call as well.
233              
234             =head2 list reminders
235              
236             You can list all of your reminders or all reminders from anyone.
237              
238             bot reminders list mine
239             bot reminders list all
240              
241             =head2 forget reminders
242              
243             You can tell the bot to forget all of your reminders or all reminders from
244             everyone.
245              
246             bot reminders forget mine
247             bot reminders forget all
248              
249             =head1 SEE ALSO
250              
251             You can look for additional information at:
252              
253             =over 4
254              
255             =item *
256              
257             L<Bot::IRC>
258              
259             =item *
260              
261             L<GitHub|https://github.com/gryphonshafer/Bot-IRC-X-Reminder>
262              
263             =item *
264              
265             L<MetaCPAN|https://metacpan.org/pod/Bot::IRC::X::Reminder>
266              
267             =item *
268              
269             L<GitHub Actions|https://github.com/gryphonshafer/Bot-IRC-X-Reminder/actions>
270              
271             =item *
272              
273             L<Codecov|https://codecov.io/gh/gryphonshafer/Bot-IRC-X-Reminder>
274              
275             =item *
276              
277             L<CPANTS|http://cpants.cpanauthors.org/dist/Bot-IRC-X-Reminder>
278              
279             =item *
280              
281             L<CPAN Testers|http://www.cpantesters.org/distro/T/Bot-IRC-X-Reminder.html>
282              
283             =back
284              
285             =for Pod::Coverage init
286              
287             =head1 AUTHOR
288              
289             Gryphon Shafer <gryphon@cpan.org>
290              
291             =head1 COPYRIGHT AND LICENSE
292              
293             This software is Copyright (c) 2016-2021 by Gryphon Shafer.
294              
295             This is free software, licensed under:
296              
297             The Artistic License 2.0 (GPL Compatible)
298              
299             =cut