File Coverage

blib/lib/App/TeleGramma/Plugin/Core/Fortune.pm
Criterion Covered Total %
statement 17 56 30.3
branch 0 6 0.0
condition 0 2 0.0
subroutine 6 13 46.1
pod 3 5 60.0
total 26 82 31.7


line stmt bran cond sub pod time code
1             package App::TeleGramma::Plugin::Core::Fortune;
2             $App::TeleGramma::Plugin::Core::Fortune::VERSION = '0.12';
3             # ABSTRACT: TeleGramma plugin to emit fortunes
4              
5 2     2   3043 use Mojo::Base 'App::TeleGramma::Plugin::Base';
  2         6  
  2         12  
6 2     2   604 use App::TeleGramma::BotAction::Listen;
  2         4  
  2         14  
7 2     2   50 use App::TeleGramma::Constants qw/:const/;
  2         4  
  2         191  
8              
9 2     2   13 use File::Spec::Functions qw/catfile/;
  2         4  
  2         74  
10 2     2   369 use Mojo::File;
  2         69021  
  2         1117  
11              
12             sub synopsis {
13 0     0 1 0 "Responds with fortunes"
14             }
15              
16             sub default_config {
17 1     1 1 4 my $self = shift;
18 1         6 return { fortune_path => "/your/path/here" };
19             }
20              
21             sub register {
22 0     0 1   my $self = shift;
23              
24             # sanity checks
25 0           my $fp = $self->read_config->{fortune_path};
26 0 0         die "fortune_path '$fp' does not exist or is not a directory - check your config\n"
27             unless (-d $fp);
28              
29             my $fortune_command = App::TeleGramma::BotAction::Listen->new(
30             command => '/fortune',
31 0     0     response => sub { $self->emit_fortune(@_) }
32 0           );
33             my $stats_command = App::TeleGramma::BotAction::Listen->new(
34             command => '/fortunestats',
35 0     0     response => sub { $self->emit_stats(@_) }
36 0           );
37              
38 0           return ($fortune_command, $stats_command);
39             }
40              
41             sub emit_fortune {
42 0     0 0   my $self = shift;
43 0           my $msg = shift;
44              
45 0           $self->reply_to($msg, $self->_get_fortune());
46              
47             # keep some stats, separated by chat and totals
48 0           my $chat_id = $msg->chat->id;
49 0           my $username = $msg->from->username;
50              
51 0           $self->store->hash('counts_'.$chat_id)->{$username}++;
52 0           $self->store->hash('totals')->{total_fortunes}++;
53 0           $self->store->save_all;
54              
55 0           return PLUGIN_RESPONDED;
56             }
57              
58             sub emit_stats {
59 0     0 0   my $self = shift;
60 0           my $msg = shift;
61              
62 0           my $chat_id = $msg->chat->id;
63 0           my $res;
64              
65 0           foreach my $username ( keys %{ $self->store->hash('counts_'.$chat_id) }) {
  0            
66 0           $res .= "$username => " . $self->store->hash('counts_'.$chat_id)->{$username} . "\n";
67             }
68              
69 0   0       $res .= "global count => " . ($self->store->hash('totals')->{total_fortunes} || 0);
70              
71 0           $self->reply_to($msg, $res);
72              
73 0           return PLUGIN_RESPONDED;
74             }
75              
76             sub _get_fortune {
77 0     0     my $self = shift;
78 0           my $path = $self->read_config->{fortune_path};
79              
80 0 0         opendir (my $dh, $path) || die "can't opendir $path: $!";
81 0 0         my @files = grep { ! /.dat$/ && -f catfile($path, $_) } readdir($dh);
  0            
82 0           closedir($dh);
83              
84 0           my $file = $files[rand @files];
85 0           my $entries = Mojo::File->new(catfile($path, $file))->slurp;
86              
87 0           my @entries = split /^%$/m, $entries;
88 0           my $entry = $entries[rand @entries];
89              
90 0           return $entry;
91             }
92              
93             1;
94              
95             __END__
96              
97             =pod
98              
99             =encoding UTF-8
100              
101             =head1 NAME
102              
103             App::TeleGramma::Plugin::Core::Fortune - TeleGramma plugin to emit fortunes
104              
105             =head1 VERSION
106              
107             version 0.12
108              
109             =head1 AUTHOR
110              
111             Justin Hawkins <justin@eatmorecode.com>
112              
113             =head1 COPYRIGHT AND LICENSE
114              
115             This software is copyright (c) 2017 by Justin Hawkins <justin@eatmorecode.com>.
116              
117             This is free software; you can redistribute it and/or modify it under
118             the same terms as the Perl 5 programming language system itself.
119              
120             =cut