Add !help command
[app-statsbot.git] / lib / App / Statsbot.pm
CommitLineData
3cdbe256
MG
1package App::Statsbot;
2
3use 5.014000;
4use strict;
5use warnings;
6
7our $VERSION = '0.001';
8
9use POE;
10use POE::Component::IRC::State;
11use POE::Component::IRC::Plugin::AutoJoin;
12use POE::Component::IRC::Plugin::Connector;
13use POE::Component::IRC::Plugin::CTCP;
14use IRC::Utils qw/parse_user/;
15
16use DBI;
17use DBD::SQLite;
18use Text::ParseWords qw/shellwords/;
19use Time::Duration qw/duration duration_exact/;
20use Time::Duration::Parse qw/parse_duration/;
21
22use List::Util qw/max/;
23
24our $DEBUG = '';
25our $TICK = 10;
26our $NICKNAME = 'statsbot';
27our $SERVER = 'irc.freenode.net';
28our $PORT = 6667;
29our $SSL = '';
30our @CHANNELS;
31our $DB = '/var/lib/statsbot/db';
32
33my $dbh;
34my $insert;
35my $update;
36my $irc;
37
38my %state;
39
40sub 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
63sub 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
78sub 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
108sub on_fatal{ die "Fatal error: $_[ARG0]" }
109
110sub on_public{
111 my ($targets,$message)=@_[ARG1,ARG2];
112 my $botnick = $irc->nick_name;
410c016e
MG
113
114 if ($message =~ /(?:$botnick[:,])?\s*!?help\s*(.*)/) {
115 $irc->yield("Try !presence username interval [truncate]");
116 $irc->yield("For example, !presence mgv '2 days'");
117 $irc->yield("or !presence mgv '1 year' 4");
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 {
134 $irc->yield("cannot parse timespec: $time");
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
1621;
163__END__
164
165=encoding utf-8
166
167=head1 NAME
168
169App::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
186App::Statsbot is a simple IRC bot that tracks the people that inhabit
187a channel. It is able to answer queries of the form "In the last <time
188interval>, how much time did <nick> spend in this channel?".
189
190It is configured via global variables in the App::Statsbot package.
191
192=over
193
194=item $DEBUG
195
196If true, print some debug information. Defaults to false.
197
198=item $TICK
199
200How often (in seconds) to poll the channel for nicks. Defaults to 10
201seconds.
202
203=item $NICKNAME
204
205The nickname of the bot. Defaults to "statsbot".
206
207=item $SERVER
208
209The IRC server. Defaults to "irc.freenode.net".
210
211=item $PORT
212
213The port. Defaults to 6667.
214
215=item $SSL
216
217If true, connect via SSL. Defaults to false.
218
219=item @CHANNELS
220
221Array of channels to connect to. Defaults to an empty array, which is
222not very useful.
223
224=item $DB
225
226Path to SQLite database. Must be writable. Will be created if it does
227not exist. Defaults to C</var/lib/statsbot/db>.
228
229=back
230
231After configuration, the bot can be started using the B<run> function,
232which can be called as either a regular function or a method.
233
234=head1 SEE ALSO
235
236L<statsbot>
237
238=head1 AUTHOR
239
240Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
241
242=head1 COPYRIGHT AND LICENSE
243
244Copyright (C) 2013-2015 by Marius Gavrilescu
245
246This library is free software; you can redistribute it and/or modify
247it under the same terms as Perl itself, either Perl version 5.20.2 or,
248at your option, any later version of Perl 5 you may have available.
249
250
251=cut
This page took 0.024304 seconds and 4 git commands to generate.