#!/usr/bin/perl -w

#TriviaHam IRC Bot - Helps quizzing in an IRC Channel
#Copyright 2001-2002 Giulio Motta - http://www.giuliomotta.com

#This program is free software; you can redistribute it and/or
#modify it under the terms of the GNU General Public License
#http://www.gnu.org/copyleft/gpl.html
#This program is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#GNU General Public License for more details.

use strict;
use POE;
use POE::Component::IRC;
use Getopt::Std;
use Text::Iconv;

sub vm {
  print $_[0]," ",`ps --no-headers -o vsz -p $$`;
}

my %args;
getopt('spnucioP', \%args);

my $lang = "FR";
my %wordlists = (
  "EN" => "/usr/share/dict/american-english",
  "FR" => "/usr/share/dict/french"
);
my $conf_dir = "$ENV{HOME}/.wordbot/";
mkdir($conf_dir, 0755) unless -d $conf_dir;
my $chart_file = "$conf_dir/chart";
my $nick = $args{n} || 'L`Romejko';
my $server = $args{s} || 'irc.kolumbus.fi';
my $port = $args{p} || 6667;
my $username = $args{u} || 'word';
my $ircname = $args{i} || "I'm WordHam Master";
my $channel = "#fmbl";
$channel = "#" . $args{c} if $args{c};
my $passwd = $args{P} || '0954trgubijrtw';
my $owner_nick = $args{o};
my ($owner, $q_num, $quiztime, %letters, $running, $current_length, $current_nick, $current_word,
  $solutions, %solutions, %chart, $timeout_sender, $type, $current_user_error,
$current_user_nick, $current_user_expr, $target, @numbers, %ops, $N,
$best_error, $best_res, $best_expr);
my @questions = ();
my $timeout = 180;
my $converter = Text::Iconv->new("utf-8", "iso8859-15");
$q_num = 0;

sub _default {
  my ($event, $args) = @_[ARG0 .. $#_];
  my @output = ( "$event: " );

  foreach my $arg ( @$args ) {
      if ( ref($arg) eq 'ARRAY' ) {
              push( @output, "[" . join(" ,", @$arg ) . "]" );
      } else {
              push ( @output, "'$arg'" );
      }
  }
  print STDOUT join ' ', @output, "\n";
  return 0;
}

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

    my $irc_session = $heap->{irc}->session_id();
    $kernel->post( $irc_session => register => 'all' );
    $kernel->post( $irc_session => connect => { } );
    undef;
}

sub irc_001 {
    my ($kernel, $sender) = @_[KERNEL,SENDER];

    $kernel->post( $sender => mode => $nick => '+i' );
    $kernel->post( $sender => join => $channel ) if $channel;
}

sub irc_disconnected {
    my ($server) = $_[ARG0];
    print "Lost connection to server $server.\n";
}

sub irc_error {
    my $err = $_[ARG0];
    print "Server error occurred! $err\n";
}

sub irc_socketerr {
    my $err = $_[ARG0];
    print "Couldn't connect to server: $err\n";
}

sub _stop {
    my ($kernel, $sender) = @_[KERNEL,SENDER];

    print "Control session stopped.\n";
    $kernel->post( $sender => quit => 'Neenios on ice!' );
    #$kernel->alias_remove( 'smileyninja' );
}

sub irc_public {
  my ($kernel, $sender, $who, $chan, $msg) = @_[KERNEL, SENDER, ARG0 .. ARG2];
  if (my ($lang_) = (lc($msg) =~ /!mot\s*(fr|en)?/)) {
    if ($lang_) {
      $lang_ = uc($lang_);
      $lang = $lang_;
    }
    &next_word($kernel, $sender);
  }
  if (lc($msg) eq "!num") {
    &next_number($kernel, $sender);
  }
  elsif (lc($msg) eq "!answer") {
    &answer($kernel, $sender);
  }
  elsif (lc($msg) eq "!score") {
    &show_chart($kernel, $sender);
  }
  elsif ($running) {
    if ($type eq "letters") {
      return if $msg !~ /^[a-z\xA0-\xFF]+$/;
      if (exists $solutions{&normalize_word($msg)}) {
        my $nick = get_nick($who);
        if (length($msg) == length($solutions->[0])) {
          $current_length = length($msg);
          $current_nick = $nick;
          $current_word = $msg;
          &answer($kernel, $sender);
        }
        elsif (length($msg) > $current_length) {
          $current_length = length($msg);
          $current_nick = $nick;
          $current_word = $msg;
          $kernel->post($sender => privmsg => $channel =>
            sprintf( "Félicitations %s ! %d lettres. Qui dit mieux ?", $nick, $current_length)
          );
        }
      }
    }
    elsif ($type eq "numbers") {
      my $res = &check_expression($msg);
      if ($res and abs($target - $res) < $current_user_error) {
        my $nick = get_nick($who);
        $current_user_error = abs($target - $res);
        $current_user_nick = $nick;
        $current_user_expr = $msg;
        if ($current_user_error == 0) {
          $kernel->post($sender => privmsg => $channel =>
            sprintf( "Félicitations %s ! Le compte est bon.", $nick)
          );
          &answer($kernel, $sender);
        }
        else {
          $kernel->post($sender => privmsg => $channel =>
            sprintf( "Félicitations %s ! Résultat à %d près. Qui dit mieux ?", $nick, $current_user_error)
          );
        }
      }
    }
  }
}

sub irc_msg {
    my ($kernel, $sender, $who, $recipients, $msg) = @_[KERNEL, SENDER, ARG0 .. ARG2];
    my ($command, $rest) = ($msg =~ /^\s*(\w+)\s*(.*)/);
    if ($who eq $owner) {
        SWITCH: for (lc $command) {
            ($_ eq 'abort')   && do{ abort ($kernel, $sender); last};
            ($_ eq 'channel') && do{ channel ($kernel, $sender, $rest); last};
            ($_ eq 'cheat')   && do{ cheat ($kernel, $sender, $rest); last};
            ($_ eq 'help')    && do{ help ($kernel, $sender); last};
            ($_ eq 'new')     && do{ new_question ($kernel, $sender, $rest); last};
            ($_ eq 'reset')   && do{ _reset ($kernel, $sender); last};
            ($_ eq 'status')  && do{ show_chart ($kernel, $sender, $rest); last};
            ($_ eq 'quit')    && do{ quit ($kernel,$sender); last};
            ($_ eq 'load')    && do{ load($kernel, $sender); last};
            ($_ eq 'timeout') && do{ set_timeout($kernel, $sender, $rest, $who); last};
            do{$kernel->post($sender => privmsg => get_nick($who) => "Unknown command $command"); last};
        }
    } elsif ($command eq 'owner') {
        set_owner ($kernel, $sender, $rest, $who);
    }
}

sub get_nick {
    $_ = shift;
    /^(.*)!.*$/ or die "Weird-ass who: $_";
    return $1;
}

sub set_owner {
    my ($kernel, $sender, $rest, $who) = @_;
    if ($rest eq $passwd) {
        $owner = $who;
        $kernel->post($sender => privmsg => get_nick($who) =>
            "You've been successfully authenticated! ".
            'Type "help" for commands.');
    }
}

sub abort {
    my ($kernel, $sender) = @_;
    $running = 0;
    #$kernel->post($sender => privmsg => $channel =>
    #    "Personne n'a répondu à la question n°$q_num." );
    if($timeout) {
      $kernel->delay('timeout');
    }
}

sub channel {
    my ($kernel, $sender);
    ($kernel, $sender, $_) = @_;
    s/^([^#])/#$1/;
    if ($channel) {
        $kernel->post($sender => part => $channel);
        undef $channel;
    }
    unless ( $kernel->post($sender => join => $_) ) {
        # this should be error checking but it won't work
        # cause i can't get an error code back
        $kernel->post($sender => 'privmsg' => get_nick($owner) => "Cannot join $_ !" );
        return;
    }
    $channel = $_;
}

sub cheat {
    my ($kernel, $sender);
    ($kernel, $sender, $_) = @_;
    if (my ($nick, $modifier) = /^\s*(.+)\s+([+-]?\d+)\s*$/) {
        $chart{$nick}{p} += $modifier; 
        $kernel->post($sender => privmsg => get_nick($owner) =>
            "Score for $nick has changed by $modifier. " .
            "Now is $chart{$nick}{p}." );
    } else {
        $kernel->post($sender => privmsg => get_nick($owner) =>
            "Cannot cheat: usage 'cheat <nick> <modifier>'" );
    }
}

sub help {
    my ($kernel, $sender) = @_;
    print "help: $sender\n";
    my $help = <<'EOH';
Usage of TriviaHam
owner <password>                    # authenticates yourself
new \q<question>\a<answer>          # new question
status [param]                      # display current standings
         #  no param               => returns first 3 positions
         #  param = 0              => returns all the positions
         #  param = <other_number> => returns that many positions
abort                               # abort current question
cheat <nick> <modifier>             # changes nick score by modifier
channel <new_channel>               # moves bot to another channel
reset                               # reset everything
quit                                # quit the bot
help                                # this help
load                                # load the questions file
timeout <value>                     # change the timeout value
EOH
    for my $line (split "\n", $help) {
        $kernel->post($sender => 'privmsg' => get_nick($owner) => $line );
         select(undef, undef, undef, 0.25);
    }
}

sub _reset {
    my ($kernel, $sender) = @_;
    ($running, %letters, %chart) = undef;
    if($timeout) {
      $kernel->delay('timeout');
    }
    $kernel->post($sender => privmsg => get_nick($owner) => "Quiz reset!" );
}

sub next_word {
  my ($kernel, $sender);
  ($kernel, $sender, $_) = @_;
  if ((time - $quiztime) > 6) {
    $running = 1;
    $type = "letters";
    $current_length = 0;
    $current_word = "";
    my $longest = 0;
    while($longest < 7) {
      %letters = &generate_letters(9);
      $solutions = &get_solutions(%letters);
      $longest = length($solutions->[0]);
    }
    undef %solutions;
    %solutions = ();
    foreach my $w (@{$solutions}) {
      $solutions{&normalize_word($w)} = 1;
    }
    $kernel->post($sender => privmsg => $channel =>
             sprintf("[$lang] Tirage: %s. J'ai trouvé %d mots, le plus long compte %d lettres",
               join(" ", &letters_to_list(%letters)), scalar(@{$solutions}), length($solutions->[0])).
             ($timeout ? " ($timeout secondes)":""));
    $quiztime = time;
    $q_num ++;
    if($timeout) {
      $kernel->delay('timeout', $timeout);
      $timeout_sender = $sender;
    }
  }
}

sub next_number {
  my ($kernel, $sender);
  ($kernel, $sender, $_) = @_;
  if ((time - $quiztime) > 6) {
    $running = 1;
    $type = "numbers";
    @numbers = &generate_numbers();
    $target = int(rand(900))+100;
    $current_user_error = $target;
    $current_user_nick = "";
    $current_user_expr = "";
    $kernel->post($sender => privmsg => $channel =>
             sprintf("Tirage: %s, cible: %d.", join(" ", @numbers), $target).
               ($timeout ? " ($timeout secondes)":""));
    $quiztime = time;
    $q_num ++;
    if($timeout) {
      $kernel->delay('timeout', $timeout);
      $timeout_sender = $sender;
    }
  }
}

sub timeout {
  my ($kernel, $sender) = @_[KERNEL, SENDER];
  &answer($kernel, $timeout_sender);
  &abort($kernel, $timeout_sender);
}

sub set_timeout {
  my ($kernel, $sender, $value, $who) = @_;
  $timeout = $value;
  $kernel->post($sender => privmsg => get_nick($owner) =>
    "Timeout set to $value seconds");
}

sub load_chart {
  if (-e $chart_file) {
    open(F, "$chart_file");
    my $line = <F>;
    chop($line);
    $q_num = $line;
    while(my $line = <F>) {
      chop($line);
      my ($nick, $points) = split(/\t/, $line);
      $chart{$nick}{p} = $points;
    }
    close(F);
  }
}

sub save_chart {
  open(F, ">$chart_file");
  print F "$q_num\n";
  foreach $nick (keys %chart) {
    print F "$nick\t$chart{$nick}{p}\n";
  }
  close(F);
}

sub answer {
  my ($kernel, $sender) = @_;
  if ($running) {
    if($timeout) {
      $kernel->delay('timeout');
    }
    if ($type eq "letters") {
      if ($current_length) {
        $kernel->post($sender => privmsg => $channel =>
            sprintf( "Félicitations %s !", $current_nick)
        );
        #$chart{$current_nick}{p} += &calc_points($current_word);
        $chart{$current_nick}{p} ++;
        &save_chart();
        $kernel->post($sender => privmsg => $channel =>
            "$current_nick a maintenant $chart{$current_nick}{p} point" .
             ($chart{$current_nick}{p}<=1?'':'s') . ".");
      }
      my $ten_best = join(", ", @{$solutions}[0..($#{$solutions} < 9 ? $#{$solutions} : 9)]);
      $kernel->post($sender => privmsg => $channel =>
        sprintf("Les dix plus longs mots sont: %s", $ten_best)
      );
      $running = 0;
      undef %letters;
    }
    elsif ($type eq "numbers") {
      if ($current_user_error < $target) {
        #$kernel->post($sender => privmsg => $channel =>
        #    sprintf( "Félicitations %s !", $current_user_nick)
        #);
        $chart{$current_user_nick}{p} ++;
        &save_chart();
        $kernel->post($sender => privmsg => $channel =>
            "$current_user_nick a maintenant $chart{$current_user_nick}{p} point" .
             ($chart{$current_user_nick}{p}<=1?'':'s') . ".");
      }
      if ($current_user_error > 0) {
        my $expr = &solve();
        $kernel->post($sender => privmsg => $channel =>
          sprintf("Une solution possible est: %s = %d", $expr, &check_expression($expr))
          );
      }
      $running = 0;
      @numbers = ();
    }
  }
}

sub show_chart {
    my ($kernel, $sender, $how_many) = @_;
    $how_many =~ s/^.*?(\d+).*?$/$1/;
    $how_many = keys %chart if ($how_many eq '0');
    $how_many ||= 3;
    $how_many--;
    my ($j, $min_color, $max_color) = (0, 6, 15);
    $kernel->post($sender => privmsg => $channel =>
        "Résultats après $q_num tirage" . ($q_num<=1?'':'s') . ".");
    my @sorted_comps = sort {$chart{$b}{p} <=> $chart{$a}{p}} keys %chart;
    for (@sorted_comps[0..$how_many]) {
        last unless $_;
        $kernel->post($sender => privmsg => $channel =>
        sprintf( "%d) \cV%-9s\cV avec %2d point%1s", ++$j, $_, $chart{$_}{p}, $chart{$_}{p}<=1?'':'s')
        );
    }
}

sub quit {
    my ($kernel, $sender) = @_;
    $kernel->post( $sender => quit => "Fini de jouer" );
    exit;
}


my %freq = ( 
  "FR" => # a -> z, FR
[8.147, 0.876, 3.063, 4.125, 17.564, 0.959, 1.051, 0.721, 7.559, 0.598, 0.041,
5.783, 2.990, 7.322, 5.289, 2.980, 1.361, 6.291, 8.013, 7.353, 5.991, 1.557,
0.020, 0.350, 0.116, 0.072],
  "EN" => 
[8.2, 1.5, 2.8, 4.3, 12.7, 2.2, 2.0, 6.1, 7.0, 0.2, 0.8, 4.0, 2.4,
6.7, 7.5, 1.9, 0.1, 6.0, 6.3, 9.1, 2.8, 1.0, 2.4, 0.2, 2.0, 0.1],
);
my %total_freq = ("FR" => 100.192, "EN" => 100.3);

sub rand_letter {
  my $r = rand($total_freq{$lang});
  #print "r = $r";
  foreach my $i (0..25) {
    $r -= $freq{$lang}->[$i];
    return chr($i+65) if $r < 0;
  }
  return "?";
} 
  
sub generate_letters { 
  my %letters = ();
  foreach my $i (1..$_[0]) {
    my $l = &rand_letter();
    #print " $l\n";
    $letters{$l} ++;
  }
  return %letters;
} 

sub normalize_word {
  my $word = shift @_;
  $word =~ tr/àâéèêëîïôùûüç/aaeeeeiiouuuc/;
  return uc($word);
}

sub word_match { 
  my $word = &normalize_word(shift @_);
  my %letters = @_;
    
  for my $l (split //, $word) {
    return 0 if ! exists $letters{$l} || $letters{$l} == 0;
    $letters{$l} --;
  }
  return 1;
}

sub letters_to_list {
  my %letters = @_;
  my @list = ();
  for my $l (sort keys(%letters)) {
    for (1..$letters{$l}) {
      push @list, $l;
    }
  }
  return @list;
}

sub calc_points {
  my $word = &normalize_word(shift @_);
  return length($word);
  my $points = 0.0;
  for my $l (split //, $word) {
    $points += 1/$freq{$lang}->[ord($l)-65];
  }
  return int($points * length($word)+.5);
}

sub utf8_to_latin9 {
  $_[0] =~ s/Ã /à/g;
  $_[0] =~ s/Ã¢/â/g;
  $_[0] =~ s/Ã©/é/g;
  $_[0] =~ s/Ã¨/è/g;
  $_[0] =~ s/Ãª/ê/g;
  $_[0] =~ s/Ã«/ë/g;
  $_[0] =~ s/Ã¯/ï/g;
  $_[0] =~ s/Ã´/ô/g;
  $_[0] =~ s/Ã¹/ù/g;
  $_[0] =~ s/Ã»/û/g;
  $_[0] =~ s/Ã§/ç/g;
}

sub get_solutions {
  my %letters = @_;
  open(DICT, "$wordlists{$lang}");
  my @words = ();
  while(my $word = <DICT>) {
    chop($word);
    next if $word =~ /'s$/;
    next if $word =~ /^[A-Z]/;
    #$word = $converter->convert($word);
    &utf8_to_latin9($word);
    next if length($word) < 3;
    push @words, $word if &word_match($word, %letters);
  }
  close DICT;
  my @sorted = sort {length($b) <=> length($a)} @words;
  return \@sorted;
}

sub generate_numbers {
  my @num = (1,2,3,4,5,6,7,8,9,10,1,2,3,4,5,6,7,8,9,10, 25, 50, 75, 100);
  for(my $i=0; $i < @num; $i++) {
    my $r = $i + int(rand(@num - $i));
    my $tmp = $num[$i];
    $num[$i] = $num[$r];
    $num[$r] = $tmp;
 }
 return @num[0..5];
}

%ops = (
"+" => sub {return $_[0] + $_[1] },
"-" => sub {return $_[0] - $_[1] },
"x" => sub {return $_[0] * $_[1] },
"/" => sub {return int($_[0] / $_[1]) }
);

sub calc_ {
  my $a = shift @_;
  my $b = shift @_;
  my $op = shift @_;
  my $expr = shift @_;
  my @num = @_;

  return if $op eq "/" && $b == 0;
  return if $op eq "/" && $a % $b != 0;
  return if ($op eq "x" || $op eq "/") && ($a == 1 || $b == 1);
  return if ($op eq "+" || $op eq "-") && ($b == 0);
  return if ($op eq "+") && ($a == 0);
  return if ($op eq "-") && ($b >= $a);
  #print "calc_($a, $b, $op, $expr)\n";
  my $res = &{$ops{$op}}($a,$b);
  push @num, [$res, $expr];
  $N++;
  #print "$expr = $res\n";
  if (abs($res - $target) < $best_error) {
    $best_error = abs($res - $target);
    $best_res = $res;
    $best_expr = $expr;
    #print "$N $expr = $res\n";
  }
  return 1 if $best_error <= int($N/200000);
  &calc(@num);
}

sub calc {
  return if @_ < 2;
  my @tmp_ = @_;
  foreach my $i (0..$#tmp_-1) {
    foreach my $j ($i+1..$#tmp_) {
      my @tmp = @tmp_;
      my ($a, $a_) = @{$tmp[$i]};
      my ($b, $b_) = @{$tmp[$j]};
      splice @tmp,$i,1;
      splice @tmp,$j-1,1;
      foreach my $op (keys %ops) {
        return if &calc_($a, $b, $op, "($a_ $op $b_)", @tmp);
        if ($op eq "-" || $op eq "/" ) {
          return if &calc_($b, $a, $op, "($b_ $op $a_)", @tmp);
        }
      }
    }
  }
}

sub check_expression {
  my $expr = shift @_;
  return 0 unless $expr =~ /^[0-9\ ()+\-\*x\/]+$/;
  my $tmp = $expr;
  $tmp =~ s/[^0-9 ]/ /g;
  $tmp =~ s/^ +//;
  $tmp =~ s/ +$//;
  my @expr_nums = split / +/, $tmp;
  my %ref_nums = ();
  for my $n (@numbers) {
    $ref_nums{$n}++;
  }
  for my $n (@expr_nums) {
    return 0 if ! $ref_nums{$n};
    $ref_nums{$n}--;
  }
  $expr =~ s/x/\*/g;
  return eval $expr;
}

sub solve {
  my @num_ = ();
  $best_error = $target;
  $N = 0;
  foreach my $n (@numbers) {
    push @num_, [$n, "$n"];
  }
  &calc(@num_);
  return $best_expr;
}

my $irc = POE::Component::IRC->spawn(
  'nick' => $nick,
  'server' => $server,
  'port' => $port,
  'ircname' => $ircname
  ) or die "Can't instantiate new IRC component!\n";

POE::Session->create(
  'package_states' => [
    'main' => [qw( _start  _stop irc_001   irc_disconnected timeout
                   irc_socketerr irc_error irc_public irc_msg)
    ],
  ],
  heap => { irc => $irc} );

&load_chart();
$poe_kernel->run();

exit 0;
