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