#!/usr/bin/perl

# vim:set ts=4 shiftwidth=4 cindent:

=pod

skillbot

Provides notifications of EVE Online skill completions over IRC.

Based on Andy Smith's twitfolk bot:
$Id: twitfolk.pl 802 2008-11-29 00:07:38Z andy $

Copyright ©2008 Andy Smith <andy+twitfolk.pl@bitfolk.com>
Portions copyright ©2008 Dominic Cleal <dominic@computerkb.co.uk>

Artistic license same as Perl.
=cut

use strict;
use warnings;

use WebService::EveOnline;
use Data::Dumper;
use Net::IRC;
use HTML::Entities;
use POSIX;
use Encode;

require 'timers.pl';

# Config variables
my %config;

my %frienduids;
my @friends;

open(CONFIG, "< skillbot.conf") or die "can't open skillbot.conf for reading: $!";
while(<CONFIG>) {
	chomp;
	s/#.*//;
	s/^\s+//;
	s/\s+$//;
	next unless length;
	my ($var, $value) = split(/\s*=\s*/, $_, 2);
	$config{$var} = $value;
}
close(CONFIG) or die "can't close skillbot.conf: $!";

my $version = '0.01';
my $ircname = "skillbot v$version";

my $DEBUG = $ENV{'IRC_DEBUG'} || 0;
my $time_to_die = 0;

justme();
daemonize();

open(PIDFILE, "> $config{'pidfile'}") or die "can't write $config{'pidfile'}: $!";
print PIDFILE "$$\n";
close(PIDFILE) or die "can't close $config{'pidfile'}: $!";

update_friends(undef);

my $irc = new Net::IRC;

my $conn = $irc->newconn(Server => $config{'target_server'},
			 Port   => $config{'target_port'},
			 Nick   => $config{'nick'},
			 Ircname => $ircname,
			 Username => $config{'username'},
			 Password => $config{'target_pass'})
	or die "can't connect to $config{'target_server'}:$config{'target_port'}: $@\n";

binmode $conn->{_socket}, ":bytes";

init_handlers($conn);
init_timers();

until ($time_to_die) {
	$irc->do_one_loop();
	do_timers_once($conn);
	do_timers_repeat($conn);
}

if ($conn) {
	$conn->quit("Caught SIGINT, bye.");
}

cleanup_and_die();

sub cleanup_and_die {
	unlink($config{'pidfile'});
	exit();
}

sub init_handlers
{
	my ($self) = shift;

	$self->add_handler('notice', \&on_notice);
	$self->add_handler([ 251,252,253,254,302,255 ], \&on_init);
	$self->add_handler('disconnect', \&on_disconnect);
	$self->add_handler(376, \&on_connect);
	$self->add_handler(433, \&on_nick_taken);
	$self->add_handler('cversion', \&on_cversion);
	$self->add_handler('cping', \&on_ping);
	$self->add_handler('join', \&on_join);
	$self->add_handler('public', \&on_public);
}

sub irc_debug
{
	my ($fmt, @args) = @_;
	
	return unless $DEBUG;

	$fmt = '%s| *** ' . $fmt . "\n";

	print sprintf($fmt, scalar gmtime(), @args);
}

=pod

Timers to set going when we start.

=cut
sub init_timers
{
	# Join channels for the first time, ~15 secs after connect
	add_one_shot_timer(15, sub { my ($timer, $self) = @_; join_channels($self); });

	# Check we are in the right channels every 10 minutes
	add_repeat_timer(600, sub { my ($timer, $self) = @_; join_channels($self); });

	# Read the "friends" config file every 6 minutes and make sure we have
	# API sessions for them all
	add_repeat_timer(360, sub { my ($timer, $self) = @_; update_friends($self); });

	# Check for new skills every 60 minutes.
	add_repeat_timer(3600, sub { my ($timer, $self) = @_; check_training($self); });
}

sub nickserv_id_now
{
	my ($self) = shift;

	$self->privmsg("NickServ", sprintf("IDENTIFY %s", $config{nick_pass}));
}

sub nickserv_release
{
	my ($self) = shift;

	$self->privmsg("NickServ", sprintf("RELEASE %s %s", $config{nick},
			$config{nick_pass}));
}

sub on_connect
{
	my $self = shift;

=pod
	$twit->update(sprintf("Connected to irc://%s/, joining channels", $config{target_server}));
	$twit->http_code == 200 or print sprintf("%s| *** %s\n", scalar gmtime(), $twit->http_message);
=cut

	$self->away($config{away}) if ($config{away});
	join_channels($self);
}

sub join_channels
{
	my $self = shift;
    $self->join('#' . $config{channel}, $config{chankey});
}

sub on_join
{
    my ($self, $event) = @_;

#    print Dumper($event);
    if ($event->nick eq $config{nick}) {
=pod
		$twit->update("In channel, checking for tweets");
		$twit->http_code == 200 or print sprintf("%s| *** %s\n", scalar gmtime(), $twit->http_message);
=cut

		# Now we're in, check for tweets as a one-off
		add_one_shot_timer(10, sub { my ($timer, $self) = @_; check_training($self); });
    }
}

sub on_ping
{
	my ($self, $event) = @_;
	my $their_nick = $event->nick;

	$self->ctcp_reply($their_nick, "PING " . join (' ', ($event->args)));
}

sub on_init
{
	my ($self, $event) = @_;
	my (@args) = ($event->args);
	shift (@args);

#    irc_debug(@args);
}

sub on_disconnect
{
	my ($self, $event) = @_;

	irc_debug("Disconnected from %s (%s). Attempting to reconnect...",
		$event->from, ($event->args())[0]);

	while (! $self->connect()) {
		irc_debug("%s", $@);
	}
}

sub on_public
{
	my ($self, $event) = @_;
	my ($their_nick, $msg) = ($event->nick, $event->args);

	if ($msg =~ /^\!eta(\s+(.+))?/i) {
		my $found = 0;
		for my $f (@friends) {
			if ((defined $2 && $f->{char}->name eq $2)
					|| (!defined $2 && $f->{nick} eq $their_nick)) {
				my $text = (defined $f->{skill}
						? sprintf("Currently training %s (finish in %s)",
								  $f->{skill}->name,
								  $f->{skill}->time_remaining)
						: "No skill currently training");

				$self->privmsg('#' . $config{channel}, sprintf(
							   chr(2) . "%s:" . chr(15) . " %s",
							   $f->{char}->name, encode("utf8", $text)));
				$found++;
			}
		}

		if ($found == 0) {
			$self->privmsg('#' . $config{channel}, "No characters found");
		}
	}
}

sub on_notice
{
	my ($self, $event) = @_;
	my ($their_nick) = $event->nick;
	my ($notice_txt) = join(' ', $event->args);

	$_ = $their_nick;

	irc_debug("Got notice from %s: %s", $_, $notice_txt);

	if (/^NickServ$/i) {
		do_nickserv_notice($self, $notice_txt);
	}
}

sub do_nickserv_notice
{
	my ($self, $notice) = @_;

	$_ = $notice;

	if (/This nick is owned by someone else/ ||
	    /This nickname is registered and protected/i) {
		irc_debug("ID to NickServ at request of NickServ");
		nickserv_id_now($self);
	} elsif (/Your nick has been recovered/i) {
		irc_debug("NickServ told me I recovered my nick, RELEASE'ing now");
		nickserv_release($self);
	} elsif (/Your nick has been released from custody/i) {
		irc_debug("NickServ told me my nick is released, /nick'ing now");
		$self->nick($config{nick});
	} else {
		irc_debug("Ignoring NickServ notice: %s", $notice);
	}
}

sub on_nick_taken
{
	my ($self) = shift;

	$self->nick($config{nick} . $$);
	nickserv_recover($self);
}

sub on_cversion
{
	my ($self, $event) = @_;

	my $vstring = sprintf("VERSION %s", $ircname);

	$self->ctcp_reply($event->nick, $vstring);
}

sub justme
{
	if (open(PIDFILE, "< $config{pidfile}")) {
		my $pid;
		chop($pid = <PIDFILE>);
		close(PIDFILE) or die "couldn't close $config{pidfile}: $1";

		if (kill(0, $pid)) {
			print "$0 already running (pid $pid), bailing out\n";
			cleanup_and_die();
		}
	}
}

sub handle_sig_int_term
{
	$time_to_die = 1;
}

=pod

Splurge the perl error to IRC for the amusement of others.

=cut
sub handle_perl_death
{
	die @_ if $^S;
	my $msg = shift;

	if ($conn) {
		$conn->quit($msg . ", died");
	}
}

sub daemonize
{
	$SIG{__DIE__} = \&handle_perl_death;
	$SIG{INT} = $SIG{TERM} = \&handle_sig_int_term;

	# Only daemonize if not running debug mode
	return if ($DEBUG);

	my $pid = fork();

	exit if $pid;
	die "Couldn't fork: $!" unless defined($pid);

	close(STDOUT);
	close(STDERR);

	POSIX::setsid() or die "Can't start a new session: $!";
}

=pod

Read a list of friends from the friends_file.  Format is:

user_id	api_key		IRC_nick	character_name

Start a line with # for a comment.  Character name is optional, if left
out then all characters will be monitored.

=cut
sub update_friends
{
	my $self = shift;

	open(FF, "< $config{friends_file}") or die "Couldn't open friends_file: $!";

	while (<FF>) {
		chomp;
		next if (/^#/);

		if (/^([0-9]+)\s+([a-z0-9]{64})\s+(\S+)(\s+(.+))?/i) {
			my $uid = $1;
			my $key = $2;
			my $nick = $3;
			my $c = $5;

			if (! $frienduids{$uid}) {
				my $api = WebService::EveOnline->new( { user_id => $uid,
														api_key => $key } );

				my $loaded = 0;
				foreach my $character ($api->characters) {
					next if defined $c && $c ne $character->name;
					push @friends, {
						char => $character,
						api => $api,
						nick => $nick
					};
					$loaded++;
				}
				
				if (defined $c && $loaded eq 0)
				{
					irc_debug("Unable to find character %s for ID %lu",
							  $c, $uid);
					next;
				}

				$frienduids{$uid} = $loaded;
				irc_debug("Adding new friend %s (%lu), %lu characters",
						  $nick, $uid, $loaded);
			}
		}
	}

	close(FF) or warn "Something weird occured when closing friends_file: $!";
}

=pod

Check for any characters that aren't known to be training, then call the API
to see if they've started, setting timers.

=cut
sub check_training
{
	my $self = shift;

	check_friend($self, $_) foreach (@friends);
}

sub check_friend
{
	my $self = shift;
	my $f = shift;

	my $skill = $f->{char}->skill->in_training;
	
	# Nothing training
	unless (defined $skill)
	{
		# If the char was training before and now has stopped then cancel
		# the announcement
		del_one_shot_timer($f->{timer}) if defined $f->{timer};
		return;
	}

	# Check for changes in the skill, skip or cancel announcement
	if (defined $f->{skill}) {
		return if $skill->id eq $f->{skill}->id;
		del_one_shot_timer($f->{timer});
	}

	my $finish = $skill->finish_time - time();
	my $prefinish = $finish - 60;

	irc_debug("Character %s is training %s %d (%s == %d sec)",
			  $f->{char}->name, $skill->name, $skill->level,
			  $skill->time_remaining, $finish);

	# Ignore bad data
	if ($finish < 0)
	{
		irc_debug("Unreasonable finish time given of %s seconds, ignoring",
				  $finish);
		return;
	}

	$f->{skill} = $skill;

	my $text = sprintf("%s has completed training skill %s %s",
					   $f->{char}->name, $skill->name, $skill->level);
	
	if ($text =~ /[\n\r]/) {
		$text =~ s/[\n\r]/ /g;
	}

	# Add a timer shortly before the end to ensure the user's still training
	if ($prefinish > 0)
	{
		add_one_shot_timer($prefinish, sub {
			check_friend($self, $f);
		});
	}

	$f->{timer} = add_one_shot_timer($skill->finish_time - time(), sub {
		$self->privmsg('#' . $config{channel}, sprintf(
				chr(2) . "%s:" . chr(15) . " %s",
				$f->{nick}, encode("utf8", $text)));
		delete $f->{skill};
	});
}

END {
	cleanup_and_die();
}