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 |