[app-statsbot.git] / lib / App / Statsbot.pm

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__

=encoding utf-8

=head1 NAME

App::Statsbot - simple IRC bot that tracks time spent in a channel

=head1 SYNOPSIS

  use App::Statsbot;
  @App::Statsbot::CHANNELS = '#oooes';
  $App::Statsbot::DEBUG = 1;
  App::Statsbot->run

  # Bot will respond to queries of the forms:
  # < mgv> !presence mgv
  # < mgv>   presence mgv '1 day'
  # < mgv> BOTNICK: !presence mgv '1 year' 2
  # < mgv> BOTNICK:    presence   mgv

=head1 DESCRIPTION

App::Statsbot is a simple IRC bot that tracks the people that inhabit
a channel. It is able to answer queries of the form "In the last <time
interval>, how much time did <nick> spend in this channel?".

It is configured via global variables in the App::Statsbot package.
These variables are initialized from environment variables with names
of the form STATSBOT_DEBUG, STATSBOT_TICK, etc. In the case of array
variables, the environment variable is treated as a space separated
list. Each configuration variable has a default value used when it is
not set explicitly or via the environment.

=over

=item $DEBUG

If true, print some debug information. Defaults to false.

=item $TICK

How often (in seconds) to poll the channel for nicks. Defaults to 10
seconds.

=item $NICKNAME

The nickname of the bot. Defaults to "statsbot".

=item $SERVER

The IRC server. Defaults to "irc.freenode.net".

=item $PORT

The port. Defaults to 6667.

=item $SSL

If true, connect via SSL. Defaults to false.

=item @CHANNELS

Array of channels to connect to. Defaults to an empty array, which is
not very useful.

=item $DB

Path to SQLite database. Must be writable. Will be created if it does
not exist. Defaults to C</var/lib/statsbot/db>.

=back

After configuration, the bot can be started using the B<run> function,
which can be called as either a regular function or a method.

=head1 SEE ALSO

L<statsbot>

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013-2016 by Marius Gavrilescu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.20.2 or,
at your option, any later version of Perl 5 you may have available.


=cut
Commit	Line	Data
3cdbe256 MG	1	package App::Statsbot;
	2
	3	use 5.014000;
	4	use strict;
	5	use warnings;
	6
a5a81502	7	our $VERSION = '1.000';
3cdbe256 MG	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
6e23c401	16	use Carp;
3cdbe256 MG	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
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	43	my $dbh;
	44	my $insert;
	45	my $update;
	46	my $irc;
	47
	48	my %state;
	49
6e23c401 MG	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
3cdbe256 MG	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
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: $!";
6e23c401 MG	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
	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
6e23c401	103	sub 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",
d6102de2 MG	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');
6e23c401 MG	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	135	sub on_fatal{ croak "Fatal error: $_[ARG0]" }
3cdbe256 MG	136
	137	sub 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
	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.
01dcdb69 MG	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.
3cdbe256 MG	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
a5a81502	268	Copyright (C) 2013-2016 by Marius Gavrilescu
3cdbe256 MG	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