###################################################################

# Copyright (c) 2004 Alan W. Mahoney. All rights reserved.
# This program is free software.  You may modify and/or
# distribute it under the same terms as Perl itself.
# This copyright notice must remain attached to the file.
#

# Fnord7's The Kingdom of Loathing (www.kingdomofloathing.com) chat bot

package KoLBot::Chatbot;

use warnings;
use strict;

use POSIX qw( floor );

use Carp;

use KoLBot::Chatbot::Rule;

BEGIN
{
  use Exporter ();
  our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $ID);

  $ID          = '$Id: Chatbot.pm 175 2006-11-22 14:00:00Z alan $';

  @ISA         = qw( Exporter KoLBot );
  @EXPORT      = qw( );
  %EXPORT_TAGS = ( );

  @EXPORT_OK   = qw();
}

# our @EXPORT_OK;
# our ($VERSION,$ID);

##########################################
## element access
##########################################

for my $field (qw(
		  rules
		  sm
		  dbh
		  ltr
		  chat_state
		  db_connect
		   )) {
  no strict "refs";
  *$field = sub {
    my $self = shift;
    $self->{$field} = shift if @_;
    return $self->{$field};
  }
}

##########################################
## Constructor:
##########################################

sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
#  my $bot = { url_i => 0,
#	      @_ };

  my $bot = KoLBot::->new(rules => {},
			  @_);

  $bot->{config}->{site} ||= ['http://www.kingdomofloathing.com/'];

  bless $bot, $class;
}

##########################################
## Initialization
##########################################

		# Those are only ones for which channel is sensible
my @types = qw( emote normal
		ban betlost betwon buff clanannounce clanbuff 
		clanleader clanstat
		logon private modwarning modannounce
		sysmessage kmail offer_cancelled offer logged_off
		mister_a
		wanged
		brick
		toilet_paper
		cream_pie );

my @channels = qw( 
		   newbie  normal  clan  trade  games  radio 
		   lounge  villa  haiku
		   dev  pvp  foodcourt  mod  kwe  valhalla
		   veteran  harem  hardcore );

sub read_rules {
  my $bot = shift;
  my $file = shift;

  open FILE,'<',$file or die "Error opening $file";

  my $inrule = 0;
  my $action = new KoLBot::Chatbot::Action();
  my $rule = {};
  while (<FILE>) {
    /^\s*#/ and next;
    
    if (/^\s*$/ && $inrule) {
#       push @{$bot->rules},
#         new KoLBot::Chatbot::Rule(%$rule,
# 				  actions => [$action]);
      $bot->add_rules(
         new KoLBot::Chatbot::Rule(%$rule,
				   actions => [$action]));
      $action = new KoLBot::Chatbot::Action();
      $rule = {};
      $inrule = 0;
      next;
    }
    if (/^\s*$/ && !$inrule) {
      next;
    }

    $inrule = 1;

    if(/^im?: (.*)/) {
      ($rule->{imessage} = $1) =~ s/\s+/\\s+/g;
      next;
    }
    /^it: (.*)/  and $rule->{itype}    = $1, next;
    /^a: (.*)/  and $action->{action}    = $1, next;
    /^om?: (.*)/ and push(@{$action->{omessage}},$1), next;
    die "unrecognized input line: $_";

  }
  close FILE;
}

sub add_rules {
  my $bot = shift;

  $bot->{rules} ||= {};

  for my $rule (@_) {
    my $match = 0;
    for (@types) {
      if($_ =~ /$rule->{itype}/i) {
	$match = 1;
	if($_ eq 'normal'
	   ||
	   $_ eq 'emote') {
	  $bot->{rules}->{$_} ||= {};
	  for my $c (@channels) {
	    $bot->{rules}->{$_}->{$c} ||= [];
	    if($c =~ /$rule->{ichannel}/i) {
	      push @{$bot->{rules}->{$_}->{$c}},$rule;
	    }
	  }
	} else {
	  $bot->{rules}->{$_} ||= [];
	  push @{$bot->{rules}->{$_}},$rule;
	}
      }
    }
    print "Rule matched no known types\n"
      unless $match;
  }
}

##########################################
## Scanners
##########################################

sub main {
  my $bot = shift;

 DBCONNECT: {
   eval {
     print "Connecting to DB.\n";

     &{$bot->{db_connect}}($bot)
       if($bot->{db_connect});

     #
     # GET STATE, a state manager is required.
     #

     $bot->{chat_state} = $bot->sm->get('!','state_hold');
     $bot->chat_state->{time} ||= 0;
     exists($bot->chat_state->{url}) 
       or $bot->chat_state->{url} = $bot->{config}->{site}->[0];

     $bot->{time} = $bot->chat_state->{time};
     $bot->{lasttime} = $bot->chat_state->{time};

     $bot->{url} = $bot->chat_state->{url};

     # actual running

     $bot->ensure(sub {
       # get hash
       $bot->get_pwd();

       $bot->enter_chat();
       print "Bot connected, ",$bot->url,"\n";

       $bot->{time} = $bot->chat_state->{time};

      print "Bot running.\n";

       $bot->scan_chat();
     });
   };
   die if($@ =~ /^CHILD/);
   redo DBCONNECT  if($@ =~ /Lost connection to MySQL server/);
   redo DBCONNECT  if($@ =~ /MySQL server has gone away/);

   print "UNKNOWN ERROR $@, waiting, re-logging-in, and continuing\n";
   sleep 3*60;
   # Some other error, re-login just to be sure, if it fails, loop anyway.
   eval {
     $bot->login();
   };
   redo DBCONNECT;
 }
}

# AWM untested
sub scan_kmail {
  my $bot = shift;

  $bot->{time} = 0;

  while (1==1) {
    my @kmail = $bot->read_kmail();

    # AWM: update time here from most recent kmail?

    exists($bot->config->{heartbeat})
      and &{$bot->config->{heartbeat}}($bot);

    # for my $km (reverse @kmail) {
    # for my $km (sort {$a->id <=> $b->id} @kmail) {
    for my $km (@kmail) {
      &{$bot->config->{process_message}}($bot,$km);
    }

    sleep($bot->config->{delay} || 60);
  }
}

##########################################
## Processors
##########################################

sub scan_hook_pre {
  my $bot = shift;

  defined($bot->config->{scan_hook_pre}) 
    and &{$bot->config->{scan_hook_pre}}($bot);
}

sub scan_hook_mid {
  my $bot = shift;

  $bot->{chat_state} = {time => $bot->{time},
			url => $bot->{url}};
  $bot->sm->set('!','state_hold',$bot->chat_state);
}

sub scan_hook_post {
  my $bot = shift;

  defined($bot->config->{heartbeat})
    and &{$bot->config->{heartbeat}}($bot);
}

sub send_chat_message {
  my $bot = shift;
  my $pid = shift;
  my $text = shift;

  my $message = new KoLBot::ChatMessage (
    user => $pid,
    message => $text,
    type => 'private',);
  print "  out: $message\n";
  $bot->send_message($message);
}

sub process_message {
  my $bot = shift;
  my $message = shift;

  my $myname = $bot->config->{user};

  if($message->{user} eq $bot->config->{user}) {
    # don't respond to yourself!
    return;
  }
  # AWM: grey chat from sickness
  $message->{message} =~ s/<font color=#333333>//gi;
  $message->{message} =~ s/<font color=#666666>//gi;
  $message->{message} =~ s/<font color=gray>//gi;
  $message->{message} =~ s/<font color=.*?>//gi;
  $message->{message} =~ s/<\/font>//gi;
  $message->{message} =~ s/\s+/ /gi;
  $message->{message} =~ s/^\s+//gi;

  if($message->{type} eq 'normal' || $message->{type} eq 'emote') {
    for my $rule (@{$bot->{rules}->{$message->{type}}->{lc($message->{channel})}}) {
#       if($message->{type} eq 'normal' && $message->{channel} eq 'clan') {
# 	print "Processing a rule, ",$rule->actions->[0]->action,
# 	" ",$rule->name,"\n";
#       }
      if($rule->process(
			message => $message,
			bot     => $bot,
			limiter => $bot->ltr,
			),
	 ) {
	return;
      }
    }
  } else {
    for my $rule (@{$bot->{rules}->{lc($message->{type})}}) {
      if($rule->process(
			message => $message,
			bot     => $bot,
			limiter => $bot->ltr,
			),
	 ) {
	return;
      }
    }
  }
}


1;
