package Bot::BasicBot::Pluggable::Module::DirkMod;

use strict;
use warnings;

use base 'Bot::BasicBot::Pluggable::Module::Infobot';
use JSON::XS;
use Time::Duration;
use LWP::Simple qw();

use Text::LevenshteinXS qw(distance);
use List::Util qw(reduce);
use Data::Dumper;
use YAML qw(LoadFile);

# TODO this might need to change if dynmap fixes their json
our $world_url = "http://map.dirkocraft.com/up/world/main/";
our $playerstate = {}; # keep these global! is something funny happenign with the modules?

our $resdb;

sub checkres {
  my ($res, $world, $x, $y, $z) = @_;
  my $areas = $res->{Areas};

  for my $area (keys %$areas) {
    my ($mx, $my, $mz, $nx, $ny, $nz) = @{$res->{Areas}{$area}}{qw(X2 Y2 Z2 X1 Y1 Z1)};
    my $rworld = $res->{Permissions}{World};

    print "WORLD: $rworld $world\n";

    if ($world eq $rworld && $x >= $mx && $y >= $my && $z >= $mz && $x < $nx && $y < $ny && $z < $nz) { # check the rectangle
      return 1;
    }
  }
}

sub getsubzone
{
  my ($zones, $world, $x, $y, $z) = @_;

  for my $zone (keys %$zones) {
    print "CHECKING $zone\n";
    my $zhr = $zones->{$zone};
    if (checkres($zhr, $world, $x, $y, $z)) {
      return ($zone, getsubzone($zhr->{Subzones}, $world, $x, $y, $z));
    }
  }

  return ();
}

sub findres {
  my ($world, $x, $y, $z) = @_;

  print Dumper \@_;

  my @names = getsubzone($resdb->{Residences}, $world, $x, $y, $z);

  return join ".", @names;
}

sub loadres
{
  $resdb = LoadFile("var/res.yml");
}

sub optipeep {
  my ($peep, $input) = @_;

  my $l = length($input);

  #print "CHECKING $input $peep\n";
  
  my $min = [length($peep)*10, $peep]; # set maxes
  for my $p (0..length($peep)-length($input)) {
    my $subpeep = substr($peep, $p, $l);
    my $d = distance($input, substr($peep, $p, $l));
#    print "LOOKING $p $subpeep $d\n";
    if ($d <= $min->[0]) {
      $min = [$d, $peep]
    }
  }

  return $min
}

sub get_seen {
  my ($self, $user) = @_;
  my $seen = $self->bot->module("MySeen");

  my $out = $seen->told({body => "seen ".$user});

  return $out;  
}

sub get_player_pos {
  my ($user)  = @_;

  return "I don't work from IRC" if ($user eq "IRC");

  no warnings 'uninitialized';
  if (time - $playerstate->{lastupdate} >= 60) { # only actually update every 60 seconds
    print "FETCHING\n";
    $playerstate->{players} = {}; #clear the users, since i don't want to figure out when people disconnnect
    my $cont = LWP::Simple::get($world_url); # get the json for the server
    my $strut = decode_json($cont);

    for my $player (@{$strut->{players}}) {
      my $key = lc $player->{name};
      $playerstate->{players}{$key} = $player;
    }

    $playerstate->{lastupdate} = time;
    loadres();
  }

  my @peeps = keys %{$playerstate->{players}};

  my $peep = reduce {$a->[0] > $b->[0] ? $b : $a} map {optipeep($_, $user)} @peeps;
  #print Dumper($peep);
  $user = $peep->[1] if ($peep->[0] < 5); # don't set it if it's too large

  if (exists($playerstate->{players}{lc $user})) { # we know where that user was
    my $pl = $playerstate->{players}{lc $user};
    my $time = ago(time - $playerstate->{lastupdate}); # TODO does this need to be in perfect sync with above? probably not
    my ($world, $x, $y, $z) = @{$pl}{qw/world x y z/};
    my $resname = findres($world, $x, $y, $z);
    my $coords = sprintf "world '%s' at %dx %dy %dz", $world, int $x, $y+1, int $z, $resname;
    my $realname = $pl->{name};
    my $out = "$realname was in ";

    if ($resname) {
      $out .= $resname . " ($coords)";
    } else {
      $out .= "($coords)";
    }
    
    $out .= " $time";
    return $out;
  } else {
    return "Are you sure that '$user' is on? They might be in the nether where I can't see.";
  }
}

my $counter = 0;
sub tick { # called every 5 seconds
  my $self = shift; # get ourself, duh

    unless ($counter++ % 48) {# every 4 minutes, 48 * 5 seconds, send the message
        my $mess = {body => "to_wanderer",
        who => "automatic",
        where => "#dirkocraft-wanderer",
        address => 0,
        };
  };
}

sub told {
    my ( $self, $mess ) = @_;
    my $body = $mess->{body};
    return unless defined $body;

    # direct commands must be addressed.
    return unless $mess->{address};

    if ( $body =~ /^forget\s+(.*)$/i ) {
      return $self->delete_factoid($1)
      ? "I forgot about $1."
      : "I don't know anything about $1.";
    }
    
    # search for a particular factoid.
    if ( $body =~ /^search\s+for\s+(.*)$/i ) {
        return "privmsg only, please" unless ( $mess->{channel} eq "msg" );
        return "searching disabled" unless $self->get("user_allow_searching");
        my @results = $self->search_factoid( split( /\s+/, $1 ) );
        unless (@results) { return "I don't know anything about $1."; }
        $#results = $self->get("user_num_results") - 1
          unless $#results < $self->get("user_num_results");
        return "I know about: " . join( ", ", map { "'$_'" } @results ) . ".";
    }
}

sub fallback {
    my ( $self, $mess ) = @_;
    my $seen = $self->bot->module("MySeen");
    my $body = $mess->{body} || "";

    my $is_priv = !defined $mess->{channel} || $mess->{channel} eq 'msg';
    return if ($mess->{channel} eq '#dirkocraft-alert' || $mess->{channel} eq '#dirkocraft-local');

    my $user = "IRC";
    if ($mess->{who} =~ /^dirkocraft\d*$/) {
      $body =~ s/^<([^>]+)>\s+//;
      $user = $1;
    }

    #23:05:18 < dirkocraft> [XmasPteradactyl disconnected]
    #23:05:21 < dirkocraft> [CaveScavenger disconnected]
    if ($mess->{who} =~ /^dirkocraft\d*$/ && $body =~ /has quit the game/) {
      $seen->update_seen($user, "Minecraft", "losing the game");
    }
    elsif ($mess->{who} =~ /^dirkocraft\d*$/ && $body =~ /has joined the server/) {
      $seen->update_seen($user, "Minecraft", "winning the game")
    }
    else {
      $seen->update_seen($user, "Minecraft", "saying '".$body."'"); # update people!
    }

    if ($body =~ /^!coords\s+(.*)/i) { # TODO ok this isn't robust, but it'll work for now
      $user = $1;
      $body = "!coords"; # rewrite the body
    };

    if ($body =~ /^!seen\s+(.*)/i) { # TODO ok this isn't robust, but it'll work for now
      $user = $1;
      $body = "!seen"; # rewrite the body
    };
    
    # request starts with "my", so we'll look for
    # a valid factoid for "$mess->{who}'s $object".
    $body =~ s/^my /$mess->{who}'s /;

    my %stopwords =
      map { lc($_) => 1 }
      split( /\s*[\s,\|]\s*/, $self->get("user_stopwords") );

    # checks to see if something starts
    #     <word> (is|are)
    # and then removes if if <word> is a stopword
    # this means that we treat "what is foo?" as "foo?"
    if ( $body =~ /^(.*?)\s+(is|are)\s+(.*)$/i ) {
        $body =~ s/^(.*?)\s+(is|are)\s+//i if $stopwords{$1};
    }
  
  # answer a factoid. this is a crazy check which ensures we will ONLY answer
  # a factoid if a) there is, or isn't, a question mark, b) we have, or haven't,
  # been addressed, c) the factoid is bigger and smaller than our requirements,
  # and d) that it doesn't look like a to-be-learned factoid (which is important
  # if the user has disabled the requiring of the question mark for answering.)
    my $body_regexp =
      $self->get("user_require_question") && !$is_priv ? qr/\?+$/ : qr/[.!?]*$/;
    if (    $body =~ s/$body_regexp//
        and ( $mess->{address} or $self->get("user_passive_answer") )
        and length($body) >= $self->get("user_min_length")
        and length($body) <= $self->get("user_max_length")
        and $body !~ /^(.*?)\s+(is|are)\s+(.*)$/i )
    {
        # get the factoid and type of relationship
        my ( $is_are, $factoid, $literal ) = $self->get_factoid($body);
        if ( !$literal && $factoid && $factoid =~ /\|/ ) {
            my @f = split /\|/, $factoid;
            $factoid = $f[ int( rand( scalar @f ) ) ];
        }

        # no factoid?
        unless ($factoid) {
            my @unknowns = split( /\|/, $self->get("user_unknown_responses") );
            my $unknown = $unknowns[ int( rand( scalar(@unknowns) ) ) - 1 ];
            return $mess->{address} ? $unknown : undef;
        }

        # variable substitution.
        $factoid =~ s/\$who/$mess->{who}/ig;

        $factoid =~ s/\$coords/get_player_pos($user)/eig;
        $factoid =~ s/\$seen/get_seen($self,$user)/eig;

        if ($factoid =~ /\$alert\$/i && $mess->{channel} =~ /dirkocraft$/i) { # if we see $ALERT$ and we're in the main channel
          $mess->{channel} = "#dirkocraft-alert";
          $factoid =~ s/\$alert\$//ig;
          $self->bot->say({who => $mess->{channel},
                           channel => $mess->{channel},
                           body => $factoid});
          return 1; # say nothing in the main channel
        }

        # emote?
        if ( $factoid =~ s/^<action>\s*//i ) {
            $self->bot->emote(
                {
                    who     => $mess->{who},
                    channel => $mess->{channel},
                    body    => $factoid
                }
            );
            return 1;

            # replying with, or without a noun? hmMmMmmm?!
        }
        elsif ($literal) {
            $body =~ s!^literal\s+!!;
            return "$body =${is_are}= $factoid";
        }
        else {
            return $factoid =~ s/^<reply>\s*//i
              ? $factoid
              : $factoid;
        }
    }

    # the only thing left is learning factoids. are we
    # addressed or are we willing to learn passively?
    # does it even look like a factoid?
    return unless ( $mess->{address} or $self->get("user_passive_learn") );
    return
      unless ( $body =~ /^(.*?)\s+(is)\s+(.*)$/i
        or $body =~ /^(.*?)\s+(are)\s+(.*)$/i );
    my ( $object, $is_are, $description ) = ( $1, $2, $3 );
    my $literal = ( $object =~ s!^literal\s+!! );

    # allow corrections and additions.
    my ( $nick, $replace, $also ) = ( $self->bot->nick, 0, 0 );
    $replace = 1 if ( $object =~ s/no,?\s+//i );    # no, $object is $fact.
    $replace = 1
      if ( $replace and $object =~ s/^\s*$nick,?\s*//i )
      ;    # no, $bot, $object is $fact.
    $also = 1 if ( $description =~ s/^also\s+//i );    # $object is also $fact.

    # ignore short, long, and stopword'd factoids.
    return if length($object) < $self->get("user_min_length");
    return if length($object) > $self->get("user_max_length");
    foreach ( keys %stopwords ) { return if $object =~ /^$_\b/; }

    # if we're replacing things, remove the factoid first.
    # $also check supports "no, $bot, $object is also $fact".
    if ( $replace and !$also ) {
        $self->delete_factoid($object);
    }

    # get any current factoid there might be.
    my ( $type, $current ) = $self->get_factoid($object);

    # we can't add without explicit instruction,
    # but shouldn't warn if this is passive.
    if ( $current and !$also and $mess->{address} ) {
        return "... but $object $type $current ...";
    }
    elsif ( $current and !$also and !$mess->{address} ) {
        return;
    }

    # add this factoid. this comment is absolutely useless. excelsior.
    $self->add_factoid( $object, $is_are, split( /\s+or\s+/, $description ) );

    # return an ack if we were addressed only
    return $mess->{address} ? "Okay." : 1;
}

1;