From 3cdbe25624e004e048af74ae3840af2d5a698e33 Mon Sep 17 00:00:00 2001
From: Marius Gavrilescu <marius@ieval.ro>
Date: Sun, 18 Oct 2015 00:36:00 +0100
Subject: [PATCH 1/1] Initial commit

---
 Changes             |   5 +
 MANIFEST            |   6 ++
 Makefile.PL         |  28 +++++
 README              |  40 ++++++++
 lib/App/Statsbot.pm | 243 ++++++++++++++++++++++++++++++++++++++++++++
 statsbot            | 116 +++++++++++++++++++++
 t/App-Statsbot.t    |   7 ++
 7 files changed, 445 insertions(+)
 create mode 100644 Changes
 create mode 100644 MANIFEST
 create mode 100644 Makefile.PL
 create mode 100644 README
 create mode 100644 lib/App/Statsbot.pm
 create mode 100755 statsbot
 create mode 100644 t/App-Statsbot.t

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..e9caba6
--- /dev/null
+++ b/Changes
@@ -0,0 +1,5 @@
+Revision history for Perl extension App::Statsbot.
+
+0.001 2015-10-18T00:36+01:00
+ - Initial release (repackage of the original script from 2013 with
+   very few additions)
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..9d4e27e
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,6 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/App-Statsbot.t
+lib/App/Statsbot.pm
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..da89098
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,28 @@
+use 5.014000;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+	NAME              => 'App::Statsbot',
+	VERSION_FROM      => 'lib/App/Statsbot.pm',
+	ABSTRACT_FROM     => 'lib/App/Statsbot.pm',
+	AUTHOR            => 'Marius Gavrilescu <marius@ieval.ro>',
+	EXE_FILES         => [qw/statsbot/],
+	MIN_PERL_VERSION  => '5.14.0',
+	LICENSE           => 'perl',
+	SIGN              => 1,
+	PREREQ_PM         => {
+		qw/POE::Component::IRC::State 0
+		   IRC::Utils                 0
+		   DBI                        0
+		   DBD::SQLite                0
+		   Text::ParseWords           0
+		   Time::Duration             0
+		   Time::Duration::Parse      0/,
+	},
+	META_MERGE        => {
+		dynamic_config => 0,
+		resources      => {
+			repository => 'https://git.ieval.ro/?p=app-statsbot.git',
+		}
+	}
+);
diff --git a/README b/README
new file mode 100644
index 0000000..dc75f0c
--- /dev/null
+++ b/README
@@ -0,0 +1,40 @@
+App-Statsbot version 0.001
+==========================
+
+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 was written as a single script in 2013 and repackaged as a module
+in 2015.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+* POE::Component::IRC::State
+* IRC::Utils
+* DBI
+* DBD::SQLite
+* Text::ParseWords
+* Time::Duration
+* Time::Duration::Parse
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2013-2015 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.
+
+
diff --git a/lib/App/Statsbot.pm b/lib/App/Statsbot.pm
new file mode 100644
index 0000000..6403bee
--- /dev/null
+++ b/lib/App/Statsbot.pm
@@ -0,0 +1,243 @@
+package App::Statsbot;
+
+use 5.014000;
+use strict;
+use warnings;
+
+our $VERSION = '0.001';
+
+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 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 $dbh;
+my $insert;
+my $update;
+my $irc;
+
+my %state;
+
+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 die "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 die "Cannot prepare query: $!";
+	$update=$dbh->prepare('UPDATE presence SET end = ? WHERE start == ? AND nick == ?') or die "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{
+	$_[KERNEL]->delay(tick => $TICK);
+
+	$irc->plugin_add(CTCP => POE::Component::IRC::Plugin::CTCP->new(
+		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 ],
+	));
+
+	$irc->yield(register => 'all');
+	$irc->yield(
+		connect => {
+			Nick     => $NICKNAME,
+			Username => 'statsbot',
+			Ircname  => 'Logging and statistics bot',
+			Server   => $SERVER,
+			Port     => $PORT,
+			UseSSL   => $SSL,
+		}
+	);
+}
+
+sub on_fatal{ die "Fatal error: $_[ARG0]" }
+
+sub on_public{
+	my ($targets,$message)=@_[ARG1,ARG2];
+	my $botnick = $irc->nick_name;
+	return unless $message =~ /(?:$botnick[:,])?\s*!?presence\s*(.*)/;
+	my ($nick, $time, $truncate) = shellwords $1;
+
+	$truncate//=-1;
+
+	unless (defined $time) {
+		$time='1 days';
+		$truncate=-1;
+	}
+
+	eval {
+		$time = parse_duration $time;
+	} or do {
+		$irc->yield("cannot parse timespec: $time");
+		return;
+	};
+
+	my $starttime=time-$time;
+
+	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)
+	}
+
+	my $ret;
+	if ($truncate == -1) {
+		use integer;
+		$ret=($uptime/3600).' hours';
+	} else {
+		$ret=duration $uptime,$truncate;
+	}
+
+	$time=duration_exact $time;
+
+	$irc->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.
+
+=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-2015 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
diff --git a/statsbot b/statsbot
new file mode 100755
index 0000000..2545fc5
--- /dev/null
+++ b/statsbot
@@ -0,0 +1,116 @@
+#!/usr/bin/perl -w
+use v5.14;
+
+use App::Statsbot;
+use Getopt::Long;
+use sigtrap qw/die normal-signals/;
+
+GetOptions(
+	'debug!'     => \$App::Statsbot::DEBUG,
+	'tick=i'     => \$App::Statsbot::TICK,
+	'nickname=s' => \$App::Statsbot::NICKNAME,
+	'server=s'   => \$App::Statsbot::SERVER,
+	'port=i'     => \$App::Statsbot::PORT,
+	'ssl!'       => \$App::Statsbot::SSL,
+	'channel=s'  => \@App::Statsbot::CHANNELS,
+	'db=s'       => \$App::Statsbot::DB,
+);
+
+App::Statsbot->run;
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+statsbot - simple IRC bot that tracks time spent in a channel
+
+=head1 SYNOPSIS
+
+  statsbot --nickname=sbot --channel='#somechan'
+  # 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
+
+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 responds to queries of the form C<presence NICK [TIME
+[PRECISION]]>, optionally preceded by C<BOTNICK:> or C<BOTNICK,>.
+There can also be an optional "!" sign before the word "presence".
+
+where BOTNICK is the nickname of the bot, NICK is the nickname of a
+channel inhabitant, TIME is the interval that is considered, and
+PRECISION is the number of units to display. For example, if a
+PRECISION of 3 yields "1 hour, 2 minutes and 10 seconds", a PRECISION
+of 2 would yield "1 hour and 2 minutes" while a PRECISION of 1 would
+yield "1 hour".
+
+By default, the interval that is considered is one day and the result
+is displayed in hours.
+
+=head1 OPTIONS
+
+=over
+
+=item B<--debug>, B<--no-debug>
+
+If B<--debug>, prints some debug information. Defaults to B<--no-debug>.
+
+=item B<--tick>=I<60>
+
+How often (in seconds) to poll the channel for nicks. Defaults to 10
+seconds.
+
+=item B<--nickname>=I<"timebot">
+
+The nickname of the bot. Defaults to "statsbot".
+
+=item B<--server>=I<"irc.oftc.net">
+
+The IRC server. Defaults to "irc.freenode.net".
+
+=item B<--port>=I<6697>
+
+The port. Defaults to 6667.
+
+=item B<--ssl>, B<--no-ssl>.
+
+If B<--ssl>, connect via SSL. Defaults to B<--no-ssl>.
+
+=item B<--channel>=I<"#mychan">
+
+The channel that should be monitored. Multiple channels can be
+monitored by repeating this option.
+
+=item B<--db>=I</path/to/some/file.sqlite>
+
+Path to SQLite database. Must be writable. Will be created if it does
+not exist. Defaults to C</var/lib/statsbot/db>.
+
+=back
+
+=head1 SEE ALSO
+
+L<App::Statsbot>
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2013-2015 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
diff --git a/t/App-Statsbot.t b/t/App-Statsbot.t
new file mode 100644
index 0000000..2f005c6
--- /dev/null
+++ b/t/App-Statsbot.t
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+BEGIN { use_ok('App::Statsbot') };
+
-- 
2.39.2