lib/App/Statsbot.pm

   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;
 113         return unless $message =~ /(?:$botnick[:,])?\s*!?presence\s*(.*)/;
 114         my ($nick, $time, $truncate) = shellwords $1;
 115
 116         $truncate//=-1;
 117
 118         unless (defined $time) {
 119                 $time='1 days';
 120                 $truncate=-1;
 121         }
 122
 123         eval {
 124                 $time = parse_duration $time;
 125         } or do {
 126                 $irc->yield("cannot parse timespec: $time");
 127                 return;
 128         };
 129
 130         my $starttime=time-$time;
 131
 132         my $sth=$dbh->prepare('SELECT start,end FROM presence WHERE end > ? AND nick == ?');
 133         $sth->execute($starttime, $nick);
 134
 135         my $uptime=0;
 136         while (my ($start, $end)=$sth->fetchrow_array) {
 137                 $uptime+=$end-max($start,$starttime)
 138         }
 139
 140         my $ret;
 141         if ($truncate == -1) {
 142                 use integer;
 143                 $ret=($uptime/3600).' hours';
 144         } else {
 145                 $ret=duration $uptime,$truncate;
 146         }
 147
 148         $time=duration_exact $time;
 149
 150         $irc->yield(privmsg => $targets, "$nick was here $ret during the last $time");
 151 }
 152
 153
 154 1;
 155 __END__
 156
 157 =encoding utf-8
 158
 159 =head1 NAME
 160
 161 App::Statsbot - simple IRC bot that tracks time spent in a channel
 162
 163 =head1 SYNOPSIS
 164
 165   use App::Statsbot;
 166   @App::Statsbot::CHANNELS = '#oooes';
 167   $App::Statsbot::DEBUG = 1;
 168   App::Statsbot->run
 169
 170   # Bot will respond to queries of the forms:
 171   # < mgv> !presence mgv
 172   # < mgv>   presence mgv '1 day'
 173   # < mgv> BOTNICK: !presence mgv '1 year' 2
 174   # < mgv> BOTNICK:    presence   mgv
 175
 176 =head1 DESCRIPTION
 177
 178 App::Statsbot is a simple IRC bot that tracks the people that inhabit
 179 a channel. It is able to answer queries of the form "In the last <time
 180 interval>, how much time did <nick> spend in this channel?".
 181
 182 It is configured via global variables in the App::Statsbot package.
 183
 184 =over
 185
 186 =item $DEBUG
 187
 188 If true, print some debug information. Defaults to false.
 189
 190 =item $TICK
 191
 192 How often (in seconds) to poll the channel for nicks. Defaults to 10
 193 seconds.
 194
 195 =item $NICKNAME
 196
 197 The nickname of the bot. Defaults to "statsbot".
 198
 199 =item $SERVER
 200
 201 The IRC server. Defaults to "irc.freenode.net".
 202
 203 =item $PORT
 204
 205 The port. Defaults to 6667.
 206
 207 =item $SSL
 208
 209 If true, connect via SSL. Defaults to false.
 210
 211 =item @CHANNELS
 212
 213 Array of channels to connect to. Defaults to an empty array, which is
 214 not very useful.
 215
 216 =item $DB
 217
 218 Path to SQLite database. Must be writable. Will be created if it does
 219 not exist. Defaults to C</var/lib/statsbot/db>.
 220
 221 =back
 222
 223 After configuration, the bot can be started using the B<run> function,
 224 which can be called as either a regular function or a method.
 225
 226 =head1 SEE ALSO
 227
 228 L<statsbot>
 229
 230 =head1 AUTHOR
 231
 232 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 233
 234 =head1 COPYRIGHT AND LICENSE
 235
 236 Copyright (C) 2013-2015 by Marius Gavrilescu
 237
 238 This library is free software; you can redistribute it and/or modify
 239 it under the same terms as Perl itself, either Perl version 5.20.2 or,
 240 at your option, any later version of Perl 5 you may have available.
 241
 242
 243 =cut