]>
Commit | Line | Data |
---|---|---|
3cdbe256 MG |
1 | package App::Statsbot; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | ||
a5a81502 | 7 | our $VERSION = '1.000'; |
3cdbe256 MG |
8 | |
9 | use POE; | |
10 | use POE::Component::IRC::State; | |
11 | use POE::Component::IRC::Plugin::AutoJoin; | |
12 | use POE::Component::IRC::Plugin::Connector; | |
13 | use POE::Component::IRC::Plugin::CTCP; | |
14 | use IRC::Utils qw/parse_user/; | |
15 | ||
6e23c401 | 16 | use Carp; |
3cdbe256 MG |
17 | use DBI; |
18 | use DBD::SQLite; | |
19 | use Text::ParseWords qw/shellwords/; | |
20 | use Time::Duration qw/duration duration_exact/; | |
21 | use Time::Duration::Parse qw/parse_duration/; | |
22 | ||
23 | use List::Util qw/max/; | |
24 | ||
25 | our $DEBUG = ''; | |
26 | our $TICK = 10; | |
27 | our $NICKNAME = 'statsbot'; | |
28 | our $SERVER = 'irc.freenode.net'; | |
29 | our $PORT = 6667; | |
30 | our $SSL = ''; | |
31 | our @CHANNELS; | |
32 | our $DB = '/var/lib/statsbot/db'; | |
33 | ||
01dcdb69 MG |
34 | { |
35 | my %cfg = (debug => \$DEBUG, tick => \$TICK, nickname => \$NICKNAME, server => \$SERVER, port => \$PORT, ssl => \$SSL, channels => \@CHANNELS, db => \$DB); | |
36 | for my $var (keys %cfg) { | |
37 | my $key = "STATSBOT_\U$var"; | |
38 | ${$cfg{$var}} = $ENV{$key} if exists $ENV{$key} && ref $cfg{$var} eq 'SCALAR'; | |
39 | @{$cfg{$var}} = split ' ', $ENV{$key} if exists $ENV{$key} && ref $cfg{$var} eq 'ARRAY'; | |
40 | } | |
41 | } | |
42 | ||
3cdbe256 MG |
43 | my $dbh; |
44 | my $insert; | |
45 | my $update; | |
46 | my $irc; | |
47 | ||
48 | my %state; | |
49 | ||
6e23c401 MG |
50 | sub _yield { $irc->yield(@_) } |
51 | sub _nick_name { $irc->nick_name } | |
52 | ||
53 | sub _uptime { | |
54 | my ($starttime, $nick) = @_; | |
55 | my $sth=$dbh->prepare('SELECT start,end FROM presence WHERE end > ? AND nick == ?'); | |
56 | $sth->execute($starttime, $nick); | |
57 | ||
58 | my $uptime=0; | |
59 | while (my ($start, $end)=$sth->fetchrow_array) { | |
60 | $uptime+=$end-max($start,$starttime) | |
61 | } | |
62 | return $uptime | |
63 | } | |
64 | ||
3cdbe256 MG |
65 | sub run { |
66 | $irc=POE::Component::IRC::State->spawn; | |
67 | POE::Session->create( | |
68 | inline_states => { | |
69 | _start => \&bot_start, | |
70 | irc_public => \&on_public, | |
71 | ||
72 | irc_chan_sync => \&tick, | |
73 | tick => \&tick, | |
74 | ||
75 | irc_disconnected => \&on_fatal, | |
76 | irc_error => \&on_fatal, | |
77 | }, | |
78 | options => { trace => $DEBUG }, | |
79 | ); | |
80 | ||
6e23c401 | 81 | $dbh=DBI->connect("dbi:SQLite:dbname=$DB") or croak "Cannot connect to database: $!"; |
3cdbe256 | 82 | $dbh->do('CREATE TABLE presence (start INTEGER, end INTEGER, nick TEXT)'); |
6e23c401 MG |
83 | $insert=$dbh->prepare('INSERT INTO presence (start, end, nick) VALUES (?,?,?)') or croak "Cannot prepare query: $!"; |
84 | $update=$dbh->prepare('UPDATE presence SET end = ? WHERE start == ? AND nick == ?') or croak "Cannot prepare query: $!"; | |
3cdbe256 MG |
85 | $poe_kernel->run(); |
86 | }; | |
87 | ||
88 | sub tick{ | |
89 | my %nicks = map {$_ => 1} $irc->nicks; | |
90 | for my $nick (keys %state) { | |
91 | $update->execute(time, $state{$nick}, $nick); | |
92 | delete $state{$nick} unless (exists $nicks{$nick}); | |
93 | delete $nicks{$nick}; | |
94 | } | |
95 | ||
96 | for (keys %nicks) { | |
97 | $state{$_}=time; | |
98 | $insert->execute($state{$_}, $state{$_}, $_); | |
99 | } | |
100 | $_[KERNEL]->delay(tick => $TICK); | |
101 | } | |
102 | ||
6e23c401 | 103 | sub bot_start{ ## no critic (RequireArgUnpacking) |
3cdbe256 MG |
104 | $_[KERNEL]->delay(tick => $TICK); |
105 | ||
106 | $irc->plugin_add(CTCP => POE::Component::IRC::Plugin::CTCP->new( | |
d6102de2 MG |
107 | version => "Statsbot/$VERSION", |
108 | source => 'https://metacpan.org/pod/App::Statsbot', | |
3cdbe256 MG |
109 | userinfo => 'A bot which keeps logs and computes channel statistics', |
110 | clientinfo => 'PING VERSION CLIENTINFO USERINFO SOURCE', | |
111 | )); | |
112 | $irc->plugin_add(AutoJoin => POE::Component::IRC::Plugin::AutoJoin->new( | |
113 | Channels => [ @CHANNELS ], | |
114 | RejoinOnKick => 1, | |
115 | Rejoin_delay => 20, | |
116 | Retry_when_banned => 60, | |
117 | )); | |
118 | $irc->plugin_add(Connecter => POE::Component::IRC::Plugin::Connector->new( | |
119 | servers => [ $SERVER ], | |
120 | )); | |
121 | ||
6e23c401 MG |
122 | _yield(register => 'all'); |
123 | _yield( | |
3cdbe256 MG |
124 | connect => { |
125 | Nick => $NICKNAME, | |
126 | Username => 'statsbot', | |
127 | Ircname => 'Logging and statistics bot', | |
128 | Server => $SERVER, | |
129 | Port => $PORT, | |
130 | UseSSL => $SSL, | |
131 | } | |
132 | ); | |
133 | } | |
134 | ||
6e23c401 | 135 | sub on_fatal{ croak "Fatal error: $_[ARG0]" } |
3cdbe256 MG |
136 | |
137 | sub on_public{ | |
138 | my ($targets,$message)=@_[ARG1,ARG2]; | |
6e23c401 | 139 | my $botnick = _nick_name; |
410c016e | 140 | |
fbde5e29 | 141 | if ($message =~ /^(?:$botnick[:,]\s*!?|\s*!)help/sx) { |
896cfdd3 MG |
142 | _yield(privmsg => $targets, 'Try !presence username interval [truncate]'); |
143 | _yield(privmsg => $targets, q/For example, !presence mgv '2 days'/); | |
144 | _yield(privmsg => $targets, q/or !presence mgv '1 year' 4/); | |
410c016e MG |
145 | return; |
146 | } | |
147 | ||
fbde5e29 | 148 | return unless $message =~ /^(?:$botnick[:,])?\s*!?presence\s*(.*)/sx; |
3cdbe256 MG |
149 | my ($nick, $time, $truncate) = shellwords $1; |
150 | ||
151 | $truncate//=-1; | |
152 | ||
153 | unless (defined $time) { | |
154 | $time='1 days'; | |
155 | $truncate=-1; | |
156 | } | |
157 | ||
158 | eval { | |
159 | $time = parse_duration $time; | |
160 | } or do { | |
6e23c401 | 161 | _yield(privmsg => $targets, "cannot parse timespec: $time"); |
3cdbe256 MG |
162 | return; |
163 | }; | |
164 | ||
6e23c401 | 165 | my $uptime=_uptime time-$time, $nick; |
3cdbe256 MG |
166 | |
167 | my $ret; | |
168 | if ($truncate == -1) { | |
169 | use integer; | |
170 | $ret=($uptime/3600).' hours'; | |
171 | } else { | |
172 | $ret=duration $uptime,$truncate; | |
173 | } | |
174 | ||
175 | $time=duration_exact $time; | |
176 | ||
6e23c401 | 177 | _yield(privmsg => $targets, "$nick was here $ret during the last $time"); |
3cdbe256 MG |
178 | } |
179 | ||
180 | ||
181 | 1; | |
182 | __END__ | |
183 | ||
184 | =encoding utf-8 | |
185 | ||
186 | =head1 NAME | |
187 | ||
188 | App::Statsbot - simple IRC bot that tracks time spent in a channel | |
189 | ||
190 | =head1 SYNOPSIS | |
191 | ||
192 | use App::Statsbot; | |
193 | @App::Statsbot::CHANNELS = '#oooes'; | |
194 | $App::Statsbot::DEBUG = 1; | |
195 | App::Statsbot->run | |
196 | ||
197 | # Bot will respond to queries of the forms: | |
198 | # < mgv> !presence mgv | |
199 | # < mgv> presence mgv '1 day' | |
200 | # < mgv> BOTNICK: !presence mgv '1 year' 2 | |
201 | # < mgv> BOTNICK: presence mgv | |
202 | ||
203 | =head1 DESCRIPTION | |
204 | ||
205 | App::Statsbot is a simple IRC bot that tracks the people that inhabit | |
206 | a channel. It is able to answer queries of the form "In the last <time | |
207 | interval>, how much time did <nick> spend in this channel?". | |
208 | ||
209 | It is configured via global variables in the App::Statsbot package. | |
01dcdb69 MG |
210 | These variables are initialized from environment variables with names |
211 | of the form STATSBOT_DEBUG, STATSBOT_TICK, etc. In the case of array | |
212 | variables, the environment variable is treated as a space separated | |
213 | list. Each configuration variable has a default value used when it is | |
214 | not set explicitly or via the environment. | |
3cdbe256 MG |
215 | |
216 | =over | |
217 | ||
218 | =item $DEBUG | |
219 | ||
220 | If true, print some debug information. Defaults to false. | |
221 | ||
222 | =item $TICK | |
223 | ||
224 | How often (in seconds) to poll the channel for nicks. Defaults to 10 | |
225 | seconds. | |
226 | ||
227 | =item $NICKNAME | |
228 | ||
229 | The nickname of the bot. Defaults to "statsbot". | |
230 | ||
231 | =item $SERVER | |
232 | ||
233 | The IRC server. Defaults to "irc.freenode.net". | |
234 | ||
235 | =item $PORT | |
236 | ||
237 | The port. Defaults to 6667. | |
238 | ||
239 | =item $SSL | |
240 | ||
241 | If true, connect via SSL. Defaults to false. | |
242 | ||
243 | =item @CHANNELS | |
244 | ||
245 | Array of channels to connect to. Defaults to an empty array, which is | |
246 | not very useful. | |
247 | ||
248 | =item $DB | |
249 | ||
250 | Path to SQLite database. Must be writable. Will be created if it does | |
251 | not exist. Defaults to C</var/lib/statsbot/db>. | |
252 | ||
253 | =back | |
254 | ||
255 | After configuration, the bot can be started using the B<run> function, | |
256 | which can be called as either a regular function or a method. | |
257 | ||
258 | =head1 SEE ALSO | |
259 | ||
260 | L<statsbot> | |
261 | ||
262 | =head1 AUTHOR | |
263 | ||
264 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
265 | ||
266 | =head1 COPYRIGHT AND LICENSE | |
267 | ||
a5a81502 | 268 | Copyright (C) 2013-2016 by Marius Gavrilescu |
3cdbe256 MG |
269 | |
270 | This library is free software; you can redistribute it and/or modify | |
271 | it under the same terms as Perl itself, either Perl version 5.20.2 or, | |
272 | at your option, any later version of Perl 5 you may have available. | |
273 | ||
274 | ||
275 | =cut |