#!/usr/bin/perl

# Copyright (c) 2009 David Buckley

# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation
# files (the "Software"), to deal in the Software without
# restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following
# conditions:

# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.

use warnings;
use strict;
use Carp;
use DBI;
use Digest::SHA1 qw(sha1_hex);

use Math::Trig;

use LWP::Simple;
use XML::Parser;

use POE;
use POE::Component::IRC;

# Create the component that will represent an IRC network.
our $irc = POE::Component::IRC->spawn();
our $name = $ENV{NAME}; # password read from ./password.name

# Create the bot session.  The new() call specifies the events the bot
# knows about and the functions that will handle those events.
POE::Session->create(
	inline_states => {
		_start     => \&bot_start,
		register_events => \&register_irc,
	},
	heap => {
		SERVER => 'irc.uwcs.co.uk',
		CHANNELS => '#SaveThePlanet',
	},
);

# The bot has successfully connected to a server.  Join a channel.
sub on_001 {
	my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];

	my $channels = $heap->{CHANNELS};
	$irc->yield( join => $channels );
	if (my $ping_id = $heap->{ping_id}) {
		$irc->delay_remove($ping_id);
		delete $heap->{ping_id};
	}
	$heap->{ping_id} = $irc->delay( [ ping => 'keepalive' ], 30 );
	$kernel->alarm( new_game => time() );
}

sub on_pong {
	my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
	if ($_[ARG0]) {
		print "PONG :$_[ARG0]\n";
	} else {
		print "PONG\n";
	}
	if (my $ping_id = $heap->{ping_id}) {
		$irc->delay_remove($ping_id);
		delete $heap->{ping_id};
	}
	$heap->{ping_id} = $irc->delay( [ ping => 'keepalive' ], 150 );
}

sub register_irc {
	my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
	my %events = (
		irc_001    => \&on_001,
		irc_433    => \&on_nickinuse,
		irc_public => \&on_public,
		irc_ctcp_action => \&on_public,
		irc_msg => \&on_private,
		irc_disconnected => \&on_disconnect,
		irc_pong => \&on_pong,
		irc_raw  => \&on_raw,
		irc_socketerr  => \&on_socketerr,
		reconnect => \&reconnect,
		register_events => \&register,
	);
	for(keys %events) {
		$kernel->state($_, $events{$_});
	}
	if ($_[ARG0]) {
		$kernel->yield('reconnect');
	}
}

sub on_socketerr {
	my ($kernel, $heap, $session, $arg) = @_[ KERNEL, HEAP, SESSION, ARG0 ];
	print "Socket error: $arg\n";
}

sub on_raw {
	my ($kernel, $heap, $session, $arg) = @_[ KERNEL, HEAP, SESSION, ARG0 ];
	print "Raw: $arg\n";
}

sub on_nickinuse {
	my ($kernel, $heap, $session, @arg) = @_[ KERNEL, HEAP, SESSION, ARG0, ARG1, ARG2 ];
	my $nick = $arg[1];
	$nick =~ s/\s.*//;
	$nick .= '0' if $nick !~ /\d$/;
	$nick =~ /(\d+)$/;
	my $num = $1;
	$num++;
	$nick =~ s/\d+$/$num/;
	print "Nick in use; trying $nick.\n";
	$irc->yield(nick => $nick);
}

sub on_disconnect {
	my ($kernel, $heap, $session) = @_[ KERNEL, HEAP, SESSION ];

	print "Disconnected; trying again in 5 secs.\n";
	sleep 5;
	
	$kernel->post( $session, 'reconnect' );
}

sub reconnect {
	my ($kernel, $heap) = @_[ KERNEL, HEAP ];

	$irc->yield( connect =>
		{
			Nick => "stp_$name",
			Username => 'stp',
			Ircname  => 'Planet Saver!',
			Server   => $heap->{SERVER},
			Port     => '6667',
			Raw      => 1,
		}
	);
}

# The bot has received a public message.  Parse it for commands, and
# respond to interesting things.

my $in_tick = 0;
my $in_game = 0;
my $botwho = "";
my $alive = 0;
my %climate;
my %players;
my %climate_old;
my %players_old;
my %playermap;
my %gamedata;
my %d_players;
my @queue;
my $ptree;
my %pscore;
sub on_public {
	my ( $kernel, $heap, $who, $where, $msg ) = @_[ KERNEL, HEAP, ARG0, ARG1, ARG2 ];
	my ($nick, $mask) = split /!/, $who;
	my $channel = $where->[0];
	print "<$who:$channel> $msg\n" if $ENV{DEBUG};
	my $isbot = $who eq $botwho;
	my $isplayer = uc $playermap{$nick};
	if (!$in_game && $msg =~ /^NEW (.+)/i) {
		my $pass = do {
			open PASS, "password.$name";
			my $pass = <PASS>;
			chomp $pass;
			close PASS;
			$pass;
		};
		$irc->yield( privmsg => $nick, "LOGIN $name ".sha1_hex($1.$pass) );
		$botwho = $who;
	} elsif ($isbot && $msg =~ /^STATE\s+(.*)/i) {
		if (!$in_tick) {
			$in_tick = 1;
			%players_old = %players;
			%climate_old = %climate;
			%players = ();
		}
		my @bits = split /\s*;\s*/, $1;
		for(@bits) {
			/([^\[]+)\[(.*)\]/;
			my $name = uc $1;
			my %data = map { split /=/ } split /,/, $2;
			if ($name eq 'CLIMATE') {
				%climate = %data;
				$climate{_don} = 0;
			} else {
				$players{$name} = \%data;
				$players{$name}{_inv} = 0;
			}
		}
	} elsif ($isbot && $msg =~ /^DISASTER (.*)/) {
		for (split /\s*;\s*/, $1) {
			/([^\[]+)\[(.*)\]/;
			my $name = uc $1;
			my %data = map { split /=/ } split /,/, $2;
			$d_players{uc $data{p}} = 1;
		}
	} elsif ($isbot && $msg =~ /^PLAYERS (.*)/) {
		if (!$in_game) {
			%playermap = ();
			$in_game = 1;
		}
		%playermap = (%playermap, map { split /=/ } split /\s*,\s*/, $1);
		my $state = 0;

		# Nom up the XML file.
		my ($pn, $ts);
		my $x = new XML::Parser(Handlers => {
			Start => sub {
				my ($e, $n, %a) = @_;
				if ($n eq 'players') {
					$state = 1;
				} elsif ($state == 1 && $n eq 'player') {
					undef $pn;
					undef $ts;
					$state = 2;
				} elsif ($state == 2 && $n eq 'name') {
					$state = 3;
				} elsif ($state == 2 && $n eq 'total_score') {
					$state = 4;
				}
			},
			End => sub {
				my ($e, $n) = @_;
				if ($state == 2 && $n eq 'player') {
					if ($pn && $ts) {
						$pscore{$pn} = $ts;
					}
				} elsif ($state > 2) {
					$state = 2;
				}
			},
			Char => sub {
				my ($e, $s) = @_;
				if ($state == 3) {
					$pn = $s;
				} elsif ($state == 4) {
					$ts = $s;
				}
			},
		});
		$ptree = $x->parse(get('http://www.bucko.me.uk/competitions/SaveThePlanet/status.pl?today=1'));
	} elsif ($isbot && $msg =~ /^CLIMATE industry_factor=(.*?);donation_factor=(.*?);recovery_factor=(.*?)/) {
		$gamedata{industry_factor} = $1;
		$gamedata{donation_factor} = $2;
		$gamedata{recovery_factor} = $3;
	} elsif ($isbot && $msg =~ /^ENDTICK/i) {
		# You have %climate with keys t and s, and %oldclimate with the old
		# values plus _don which has the donations on the last turn.
		# %players with keys player names, and values are hashes with keys
		# i and c. %oldplayers has last turns values, including _inv which
		# stores how much they invested last turn.
		# $pscore{player_name} is their total score so far today.
		# $d_players{player_name} stores if they had a disaster.
		# All hash keys are in UPPER CASE.
		$in_tick = 0;
		if ($climate{t} == 0) {
			my $s = 0;
			$s += $_->{i} for values %players;
			$gamedata{capacity} = $s/keys %players;
		}

		if ($players{uc $name}) {
			$alive = 1;
		} else {
			$alive = 0;
		}

		if ($alive) {
			# Do things.
			my $cash = $players{uc $name}{c};
			my $what;
			if ($name eq 'bastard') {
				$what = "INVEST $cash";
			} elsif ($name eq 'altruist') {
				$what = "DONATE $cash";
			} else {
				$what = "DONATE ".int($cash/2)."; INVEST ".int($cash/2);
			}
			$irc->yield( privmsg => $where, $what );
		}

		# Process this turn's messages.
		for(@queue) {
			on_public(@$_);
		}
		@queue = ();
		%d_players = ();
	} elsif ($isbot && $msg =~ /^RESULT|^RESET/) {
		$in_game = 0;
		$in_tick = 0;
		$alive = 0;
	} elsif ($isplayer) {
		if (!$in_tick) {
			for(split /\s*;\s*/, $msg) {
				if (/DONATE (\d+)/ && $players{$isplayer}{c} >= $1) {
					$players{$isplayer}{c} -= $1;
					$climate{_don} += $1;
				} elsif ($msg =~ /INVEST (\d+)/ && $players{$isplayer}{c} >= $1) {
					$players{$isplayer}{c} -= $1;
					$players{$isplayer}{_inv} += $1;
				} elsif ($msg =~ /CUTBACK (\d+)/ && $players{$isplayer}{i} >= $1) {
					$players{$isplayer}{i} -= $1;
				}
			}
		} else {
			push @queue, \@_;
		}
	}
}

# The bot session has started.  Register this bot with the "magnet"
# IRC component.  Select a nickname.  Connect to a server.
sub bot_start {
	my $kernel  = $_[KERNEL];
	my $heap    = $_[HEAP];
	my $session = $_[SESSION];

	$irc->yield( register => "all" );

	$kernel->post($session, 'register_events', 1);
}

sub random_normal {
	my ($avg, $stddev) = @_;
	return $avg + $stddev * sqrt( -2 * log(rand()) ) * cos(2*pi* rand());
}

# Run the bot until it is done.
$poe_kernel->run();
exit 0;