]> 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
a5a81502 7our $VERSION = '1.000';
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
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
43my $dbh;
44my $insert;
45my $update;
46my $irc;
47
48my %state;
49
6e23c401
MG
50sub _yield { $irc->yield(@_) }
51sub _nick_name { $irc->nick_name }
52
53sub _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
65sub 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
88sub 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 103sub 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 135sub on_fatal{ croak "Fatal error: $_[ARG0]" }
3cdbe256
MG
136
137sub 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
1811;
182__END__
183
184=encoding utf-8
185
186=head1 NAME
187
188App::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
205App::Statsbot is a simple IRC bot that tracks the people that inhabit
206a channel. It is able to answer queries of the form "In the last <time
207interval>, how much time did <nick> spend in this channel?".
208
209It is configured via global variables in the App::Statsbot package.
01dcdb69
MG
210These variables are initialized from environment variables with names
211of the form STATSBOT_DEBUG, STATSBOT_TICK, etc. In the case of array
212variables, the environment variable is treated as a space separated
213list. Each configuration variable has a default value used when it is
214not set explicitly or via the environment.
3cdbe256
MG
215
216=over
217
218=item $DEBUG
219
220If true, print some debug information. Defaults to false.
221
222=item $TICK
223
224How often (in seconds) to poll the channel for nicks. Defaults to 10
225seconds.
226
227=item $NICKNAME
228
229The nickname of the bot. Defaults to "statsbot".
230
231=item $SERVER
232
233The IRC server. Defaults to "irc.freenode.net".
234
235=item $PORT
236
237The port. Defaults to 6667.
238
239=item $SSL
240
241If true, connect via SSL. Defaults to false.
242
243=item @CHANNELS
244
245Array of channels to connect to. Defaults to an empty array, which is
246not very useful.
247
248=item $DB
249
250Path to SQLite database. Must be writable. Will be created if it does
251not exist. Defaults to C</var/lib/statsbot/db>.
252
253=back
254
255After configuration, the bot can be started using the B<run> function,
256which can be called as either a regular function or a method.
257
258=head1 SEE ALSO
259
260L<statsbot>
261
262=head1 AUTHOR
263
264Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
265
266=head1 COPYRIGHT AND LICENSE
267
a5a81502 268Copyright (C) 2013-2016 by Marius Gavrilescu
3cdbe256
MG
269
270This library is free software; you can redistribute it and/or modify
271it under the same terms as Perl itself, either Perl version 5.20.2 or,
272at your option, any later version of Perl 5 you may have available.
273
274
275=cut
This page took 0.05135 seconds and 4 git commands to generate.