File Coverage

blib/lib/App/TeleGramma/Plugin/Core/Timer.pm
Criterion Covered Total %
statement 46 47 97.8
branch 4 4 100.0
condition 2 3 66.6
subroutine 11 12 91.6
pod 3 5 60.0
total 66 71 92.9


line stmt bran cond sub pod time code
1             package App::TeleGramma::Plugin::Core::Timer;
2             $App::TeleGramma::Plugin::Core::Timer::VERSION = '0.12';
3             # ABSTRACT: TeleGramma plugin to set timers
4              
5 2     2   2338 use Mojo::Base 'App::TeleGramma::Plugin::Base';
  2         5  
  2         13  
6 2     2   983 use App::TeleGramma::BotAction::Listen;
  2         6  
  2         14  
7 2     2   58 use App::TeleGramma::Constants qw/:const/;
  2         5  
  2         170  
8 2     2   773 use Time::Duration::Parse qw/parse_duration/;
  2         2975  
  2         12  
9              
10             sub synopsis {
11 0     0 1 0 "Set timers for a future reminder"
12             }
13              
14             sub default_config {
15 1     1 1 3 my $self = shift;
16 1         4 return { };
17             }
18              
19             sub register {
20 1     1 1 792 my $self = shift;
21              
22             my $timer_help = App::TeleGramma::BotAction::Listen->new(
23             command => qr{/timer}i,
24 1     1   6 response => sub { $self->timer_help(@_) }
25 1         16 );
26              
27             my $timer_set_exact = App::TeleGramma::BotAction::Listen->new(
28             command => qr{/timer\s(.*)}i,
29 4     4   24 response => sub { $self->timer_set(@_) }
30 1         27 );
31              
32 1         8 return ($timer_set_exact, $timer_help);
33             }
34              
35             sub timer_help {
36 1     1 0 2 my $self = shift;
37 1         2 my $msg = shift;
38 1         8 $self->reply_to($msg, "examples: /timer remind me to weed and feed in 3 hours");
39 1         1076 return PLUGIN_RESPONDED_LAST;
40             }
41              
42             sub timer_set {
43 4     4 0 8 my $self = shift;
44 4         7 my $msg = shift;
45              
46 4         10 my $text = $msg->text;
47 4         25 my ($request) = ($text =~ m{/timer\s+(.*)}i);
48              
49             # remove some common prefixes from the request
50 4         17 $request =~ s/^remind me to//;
51 4         11 $request =~ s/^remind me//;
52 4         7 $request =~ s/^tell me to//;
53              
54             # try to parse the thing, starting at the first number
55 4         19 my ($timer_text, $duration_text) = ($request =~ /^\s*(.+)\s+in\s+(\d.*)/);
56 4 100       13 if (! $duration_text) {
57 1         5 $self->reply_to($msg, "Sorry, I can't work out when you mean from '$text'");
58 1         967 return PLUGIN_RESPONDED_LAST;
59             }
60              
61 3         5 my $duration = eval { parse_duration($duration_text) };
  3         13  
62 3 100 66     309 if ($@ || ! $duration) {
63 1         7 $self->reply_to($msg, "Sorry, I can't work out when you mean from '$duration_text'");
64 1         1319 return PLUGIN_RESPONDED_LAST;
65             }
66              
67             Mojo::IOLoop->timer($duration => sub {
68 2     2   5998824 my $loop = shift;
69 2         25 my $message = "Hey \@" . $msg->from->username . ", this is your reminder to $timer_text";
70 2         61 $self->reply_to($msg, $message);
71 2         22 });
72              
73 2         247 $self->reply_to($msg, "Will remind you '$timer_text' in $duration_text");
74 2         2227 return PLUGIN_RESPONDED_LAST;
75             }
76              
77             1;
78              
79             __END__
80              
81             =pod
82              
83             =encoding UTF-8
84              
85             =head1 NAME
86              
87             App::TeleGramma::Plugin::Core::Timer - TeleGramma plugin to set timers
88              
89             =head1 VERSION
90              
91             version 0.12
92              
93             =head1 AUTHOR
94              
95             Justin Hawkins <justin@eatmorecode.com>
96              
97             =head1 COPYRIGHT AND LICENSE
98              
99             This software is copyright (c) 2017 by Justin Hawkins <justin@eatmorecode.com>.
100              
101             This is free software; you can redistribute it and/or modify it under
102             the same terms as the Perl 5 programming language system itself.
103              
104             =cut