lib/App/Statsbot.pm

   1 package App::Statsbot;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '1.000';
   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 Carp;
  17 use DBI;
  18 use DBD::SQLite;
  19 use Text::ParseWords qw/shellwords/;
  20 use Time::Duration qw/duration duration_exact/;
  21 use Time::Duration::Parse qw/parse_duration/;
  22
  23 use List::Util qw/max/;
  24
  25 our $DEBUG = '';
  26 our $TICK  = 10;
  27 our $NICKNAME = 'statsbot';
  28 our $SERVER = 'irc.freenode.net';
  29 our $PORT = 6667;
  30 our $SSL = '';
  31 our @CHANNELS;
  32 our $DB = '/var/lib/statsbot/db';
  33
  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
  43 my $dbh;
  44 my $insert;
  45 my $update;
  46 my $irc;
  47
  48 my %state;
  49
  50 sub _yield { $irc->yield(@_) }
  51 sub _nick_name { $irc->nick_name }
  52
  53 sub _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
  65 sub 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
  81         $dbh=DBI->connect("dbi:SQLite:dbname=$DB") or croak "Cannot connect to database: $!";
  82         $dbh->do('CREATE TABLE presence (start INTEGER, end INTEGER, nick TEXT)');
  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: $!";
  85         $poe_kernel->run();
  86 };
  87
  88 sub 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
 103 sub bot_start{ ## no critic (RequireArgUnpacking)
 104         $_[KERNEL]->delay(tick => $TICK);
 105
 106         $irc->plugin_add(CTCP => POE::Component::IRC::Plugin::CTCP->new(
 107                 version => "Statsbot/$VERSION",
 108                 source => 'https://metacpan.org/pod/App::Statsbot',
 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
 122         _yield(register => 'all');
 123         _yield(
 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
 135 sub on_fatal{ croak "Fatal error: $_[ARG0]" }
 136
 137 sub on_public{
 138         my ($targets,$message)=@_[ARG1,ARG2];
 139         my $botnick = _nick_name;
 140
 141         if ($message =~ /^(?:$botnick[:,]\s*!?|\s*!)help/sx) {
 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/);
 145                 return;
 146         }
 147
 148         return unless $message =~ /^(?:$botnick[:,])?\s*!?presence\s*(.*)/sx;
 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 {
 161                 _yield(privmsg => $targets, "cannot parse timespec: $time");
 162                 return;
 163         };
 164
 165         my $uptime=_uptime time-$time, $nick;
 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
 177         _yield(privmsg => $targets, "$nick was here $ret during the last $time");
 178 }
 179
 180
 181 1;
 182 __END__
 183
 184 =encoding utf-8
 185
 186 =head1 NAME
 187
 188 App::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
 205 App::Statsbot is a simple IRC bot that tracks the people that inhabit
 206 a channel. It is able to answer queries of the form "In the last <time
 207 interval>, how much time did <nick> spend in this channel?".
 208
 209 It is configured via global variables in the App::Statsbot package.
 210 These variables are initialized from environment variables with names
 211 of the form STATSBOT_DEBUG, STATSBOT_TICK, etc. In the case of array
 212 variables, the environment variable is treated as a space separated
 213 list. Each configuration variable has a default value used when it is
 214 not set explicitly or via the environment.
 215
 216 =over
 217
 218 =item $DEBUG
 219
 220 If true, print some debug information. Defaults to false.
 221
 222 =item $TICK
 223
 224 How often (in seconds) to poll the channel for nicks. Defaults to 10
 225 seconds.
 226
 227 =item $NICKNAME
 228
 229 The nickname of the bot. Defaults to "statsbot".
 230
 231 =item $SERVER
 232
 233 The IRC server. Defaults to "irc.freenode.net".
 234
 235 =item $PORT
 236
 237 The port. Defaults to 6667.
 238
 239 =item $SSL
 240
 241 If true, connect via SSL. Defaults to false.
 242
 243 =item @CHANNELS
 244
 245 Array of channels to connect to. Defaults to an empty array, which is
 246 not very useful.
 247
 248 =item $DB
 249
 250 Path to SQLite database. Must be writable. Will be created if it does
 251 not exist. Defaults to C</var/lib/statsbot/db>.
 252
 253 =back
 254
 255 After configuration, the bot can be started using the B<run> function,
 256 which can be called as either a regular function or a method.
 257
 258 =head1 SEE ALSO
 259
 260 L<statsbot>
 261
 262 =head1 AUTHOR
 263
 264 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 265
 266 =head1 COPYRIGHT AND LICENSE
 267
 268 Copyright (C) 2013-2016 by Marius Gavrilescu
 269
 270 This library is free software; you can redistribute it and/or modify
 271 it under the same terms as Perl itself, either Perl version 5.20.2 or,
 272 at your option, any later version of Perl 5 you may have available.
 273
 274
 275 =cut