File Coverage

blib/lib/App/Statsbot.pm

Criterion	Covered	Total	%
statement	74	98	75.5
branch	10	18	55.5
condition	2	2	100.0
subroutine	18	22	81.8
pod	0	5	0.0
total	104	145	71.7

package App::Statsbot;

use 5.014000;
use strict;
use warnings;

our $VERSION = '1.000';

use POE;
use POE::Component::IRC::State;
use POE::Component::IRC::Plugin::AutoJoin;
use POE::Component::IRC::Plugin::Connector;
use POE::Component::IRC::Plugin::CTCP;
use IRC::Utils qw/parse_user/;

use Carp;
use DBI;
use DBD::SQLite;
use Text::ParseWords qw/shellwords/;
use Time::Duration qw/duration duration_exact/;
use Time::Duration::Parse qw/parse_duration/;

use List::Util qw/max/;

our $DEBUG = '';
our $TICK  = 10;
our $NICKNAME = 'statsbot';
our $SERVER = 'irc.freenode.net';
our $PORT = 6667;
our $SSL = '';
our @CHANNELS;
our $DB = '/var/lib/statsbot/db';

{
	my %cfg = (debug => \$DEBUG, tick => \$TICK, nickname => \$NICKNAME, server => \$SERVER, port => \$PORT, ssl => \$SSL, channels => \@CHANNELS, db => \$DB);
	for my $var (keys %cfg) {
		my $key = "STATSBOT_\U$var";
		${$cfg{$var}} = $ENV{$key} if exists $ENV{$key} && ref $cfg{$var} eq 'SCALAR';
		@{$cfg{$var}} = split ' ', $ENV{$key} if exists $ENV{$key} && ref $cfg{$var} eq 'ARRAY';
	}
}

my $dbh;
my $insert;
my $update;
my $irc;

my %state;

sub _yield { $irc->yield(@_) }
sub _nick_name { $irc->nick_name }

sub _uptime {
	my ($starttime, $nick) = @_;
	my $sth=$dbh->prepare('SELECT start,end FROM presence WHERE end > ? AND nick == ?');
	$sth->execute($starttime, $nick);

	my $uptime=0;
	while (my ($start, $end)=$sth->fetchrow_array) {
		$uptime+=$end-max($start,$starttime)
	}
	return $uptime
}

sub run {
	$irc=POE::Component::IRC::State->spawn;
	POE::Session->create(
		inline_states => {
			_start     => \&bot_start,
			irc_public => \&on_public,

			irc_chan_sync => \&tick,
			tick => \&tick,

			irc_disconnected => \&on_fatal,
			irc_error => \&on_fatal,
		},
		options => { trace => $DEBUG },
	);

	$dbh=DBI->connect("dbi:SQLite:dbname=$DB") or croak "Cannot connect to database: $!";
	$dbh->do('CREATE TABLE presence (start INTEGER, end INTEGER, nick TEXT)');
	$insert=$dbh->prepare('INSERT INTO presence (start, end, nick) VALUES (?,?,?)') or croak "Cannot prepare query: $!";
	$update=$dbh->prepare('UPDATE presence SET end = ? WHERE start == ? AND nick == ?') or croak "Cannot prepare query: $!";
	$poe_kernel->run();
};

sub tick{
	my %nicks = map {$_ => 1} $irc->nicks;
	for my $nick (keys %state) {
		$update->execute(time, $state{$nick}, $nick);
		delete $state{$nick} unless (exists $nicks{$nick});
		delete $nicks{$nick};
	}

	for (keys %nicks) {
		$state{$_}=time;
		$insert->execute($state{$_}, $state{$_}, $_);
	}
	$_[KERNEL]->delay(tick => $TICK);
}

sub bot_start{ ## no critic (RequireArgUnpacking)
	$_[KERNEL]->delay(tick => $TICK);

	$irc->plugin_add(CTCP => POE::Component::IRC::Plugin::CTCP->new(
		version => "Statsbot/$VERSION",
		source => 'https://metacpan.org/pod/App::Statsbot',
		userinfo => 'A bot which keeps logs and computes channel statistics',
		clientinfo => 'PING VERSION CLIENTINFO USERINFO SOURCE',
	));
	$irc->plugin_add(AutoJoin => POE::Component::IRC::Plugin::AutoJoin->new(
		Channels => [ @CHANNELS ],
		RejoinOnKick => 1,
		Rejoin_delay => 20,
		Retry_when_banned => 60,
	));
	$irc->plugin_add(Connecter => POE::Component::IRC::Plugin::Connector->new(
		servers => [ $SERVER ],
	));

	_yield(register => 'all');
	_yield(
		connect => {
			Nick     => $NICKNAME,
			Username => 'statsbot',
			Ircname  => 'Logging and statistics bot',
			Server   => $SERVER,
			Port     => $PORT,
			UseSSL   => $SSL,
		}
	);
}

sub on_fatal{ croak "Fatal error: $_[ARG0]" }

sub on_public{
	my ($targets,$message)=@_[ARG1,ARG2];
	my $botnick = _nick_name;

	if ($message =~ /^(?:$botnick[:,]\s*!?|\s*!)help/sx) {
		_yield(privmsg => $targets, 'Try !presence username interval [truncate]');
		_yield(privmsg => $targets, q/For example, !presence mgv '2 days'/);
		_yield(privmsg => $targets, q/or !presence mgv '1 year' 4/);
		return;
	}

	return unless $message =~ /^(?:$botnick[:,])?\s*!?presence\s*(.*)/sx;
	my ($nick, $time, $truncate) = shellwords $1;

	$truncate//=-1;

	unless (defined $time) {
		$time='1 days';
		$truncate=-1;
	}

	eval {
		$time = parse_duration $time;
	} or do {
		_yield(privmsg => $targets, "cannot parse timespec: $time");
		return;
	};

	my $uptime=_uptime time-$time, $nick;

	my $ret;
	if ($truncate == -1) {
		use integer;
		$ret=($uptime/3600).' hours';
	} else {
		$ret=duration $uptime,$truncate;
	}

	$time=duration_exact $time;

	_yield(privmsg => $targets, "$nick was here $ret during the last $time");
}


1;
__END__