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