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