| 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 | |
| 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 | |
| 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 | |
| 162 | 1; |
| 163 | __END__ |
| 164 | |
| 165 | =encoding utf-8 |
| 166 | |
| 167 | =head1 NAME |
| 168 | |
| 169 | App::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 | |
| 186 | App::Statsbot is a simple IRC bot that tracks the people that inhabit |
| 187 | a channel. It is able to answer queries of the form "In the last <time |
| 188 | interval>, how much time did <nick> spend in this channel?". |
| 189 | |
| 190 | It is configured via global variables in the App::Statsbot package. |
| 191 | |
| 192 | =over |
| 193 | |
| 194 | =item $DEBUG |
| 195 | |
| 196 | If true, print some debug information. Defaults to false. |
| 197 | |
| 198 | =item $TICK |
| 199 | |
| 200 | How often (in seconds) to poll the channel for nicks. Defaults to 10 |
| 201 | seconds. |
| 202 | |
| 203 | =item $NICKNAME |
| 204 | |
| 205 | The nickname of the bot. Defaults to "statsbot". |
| 206 | |
| 207 | =item $SERVER |
| 208 | |
| 209 | The IRC server. Defaults to "irc.freenode.net". |
| 210 | |
| 211 | =item $PORT |
| 212 | |
| 213 | The port. Defaults to 6667. |
| 214 | |
| 215 | =item $SSL |
| 216 | |
| 217 | If true, connect via SSL. Defaults to false. |
| 218 | |
| 219 | =item @CHANNELS |
| 220 | |
| 221 | Array of channels to connect to. Defaults to an empty array, which is |
| 222 | not very useful. |
| 223 | |
| 224 | =item $DB |
| 225 | |
| 226 | Path to SQLite database. Must be writable. Will be created if it does |
| 227 | not exist. Defaults to C</var/lib/statsbot/db>. |
| 228 | |
| 229 | =back |
| 230 | |
| 231 | After configuration, the bot can be started using the B<run> function, |
| 232 | which can be called as either a regular function or a method. |
| 233 | |
| 234 | =head1 SEE ALSO |
| 235 | |
| 236 | L<statsbot> |
| 237 | |
| 238 | =head1 AUTHOR |
| 239 | |
| 240 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> |
| 241 | |
| 242 | =head1 COPYRIGHT AND LICENSE |
| 243 | |
| 244 | Copyright (C) 2013-2015 by Marius Gavrilescu |
| 245 | |
| 246 | This library is free software; you can redistribute it and/or modify |
| 247 | it under the same terms as Perl itself, either Perl version 5.20.2 or, |
| 248 | at your option, any later version of Perl 5 you may have available. |
| 249 | |
| 250 | |
| 251 | =cut |