#!/usr/bin/perl

use strict;
use DBI;


# IRC Server stuff
use POE;
use POE::Component::IRC;

my $current_nick = "francoise";
my $channel      = '#test';

POE::Component::IRC->new("irc_client");

POE::Session->new ( _start     => \&irc_start,
                    irc_join   => \&irc_join,
                    irc_part   => \&irc_part,
                    irc_nick   => \&irc_nick,
                    irc_quit   => \&irc_quit,
                    irc_376    => \&irc_connect,  #end of motd
                    irc_372    => \&irc_motd,
                    irc_353    => \&irc_names,
                    irc_311    => \&irc_whois,
                    irc_public => \&irc_pub_msg,
                    irc_msg    => \&irc_priv_msg,
);

my %commands = ( 'help'     => \&francoise_help,
                 'stat'     => \&francoise_stat,
                 'topten'   => \&francoise_topten,
                 'topten0r' => \&francoise_topten0r,
                 'forget'   => \&francoise_forget,
               );

my @hilfsverb = ( 'bin', 'bist', 'ist', 'is', 'sind', 'seid',
                  'werde', 'wirst', 'wird', 'werden', 'werdet',
                  'war', 'warst', 'waren', 'wart',
                  'habe', 'hast', 'hat', 'haben', 'habt',
                  'hatte', 'hattest', 'hatten', 'hattet' );

my $hv = join( '|', @hilfsverb);

# Database connection stuff
my $dbh = DBI->connect("DBI:Pg:dbname='francoise'", 'francoise', 'kiffer')
    or die "ohoh, datenbank b0rken: $!";

sub irc_start {
  # KERNEL, HEAP, and SESSION are constants exported by POE
  my $kernel = $_[KERNEL];
  my $heap = $_[HEAP];
  my $session = $_[SESSION];

  $kernel->refcount_increment( $session->ID(), "my bot");
  $kernel->post(irc_client=> register=> "all");

  $kernel->post(irc_client=>connect=> {  Nick     => $current_nick,
                                         Username => 'francoise',
                                         Ircname  => 'francoise',
                                         Server   => 'irc.kiffer.de',
                                         Port     => '6667',
                                      }
                );
}

sub irc_connect {
  my $kernel = $_[KERNEL];

  $kernel->post(irc_client=>join=>$channel);
}

sub irc_motd {
  my $msg = $_[ARG1];

  print "MOTD: $msg\n";
}

sub irc_names {
  my $kernel = $_[KERNEL];
  my $names = (split /:/, $_[ARG1])[1];
  my $channel = (split /:/, $_[ARG1])[0];

  $channel =~ s/[@|=] (.*?) /$1/;

  print "#-> Users on $channel [ $names ]\n";

  for my $user (split / /, $names) {
    $user =~ s/^[@%+]//;
    $kernel->post( 'irc_client', 'whois', $user);
  }
}

#nick change
sub irc_nick {
  my $oldnick_ = (split /!/, $_[ARG0])[0];
  my $newnick_ = $_[ARG1];

  my $oldnick = francoise_getbasenick( $oldnick_ );
  my $newnick = francoise_getbasenick( $newnick_ );

  if( $newnick_ ne $current_nick && $newnick ne $oldnick ) {
    francoise_verifyuser( $newnick_, '', 0 );
  }

  print "#-> $oldnick_ is now known as $newnick_\n";
}

#user parted
sub irc_part {
  my $nick = (split /!/, $_[ARG0])[0];
  my $channel = $_[ARG1];

  print "#-> $nick has parted $channel\n";
}

#user joined
sub irc_join {
  my $kernel = $_[KERNEL];
  my $nick = (split /!/, $_[ARG0])[0];
  my $channel = $_[ARG1];
  my $host = (split /@/, $_[ARG0])[1];

  if( $nick eq $current_nick ) {
    $kernel->post( 'irc_client', 'privmsg', $channel, 'Hier bin ich!');
  } else {
    francoise_verifyuser( $nick, $host, 1 );
  }

  print "#-> $nick has joined $channel\n";
}

#user quit
sub irc_quit {
  my $nick = $_[ARG0];
  my $reason = $_[ARG1];

  print "#-> $nick has quit ($reason)\n";
}

sub irc_pub_msg{
  my $kernel   = $_[KERNEL];
  my $nick_    = (split /!/, $_[ARG0])[0];
  my $channel  = $_[ARG1]->[0];
  my $msg      = $_[ARG2];
  my @words    = (split / /, $msg);
  my $numwords = $#words;

  my $nick = francoise_verifyuser( $nick_, "", 0, $kernel );

  if( $msg =~ /^!(\S+)(.*)$/ ) {
    &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $channel, $msg );
  }

 if( $msg =~ /^wo ist (\S+)\??$/i ) {
    my $wois_ = $1;
    my $wois  = francoise_getbasenick( $1 );
    my $sth   = $dbh->prepare( "SELECT awaymsg FROM users WHERE nick = '$wois' AND isaway = 'true'");
    $sth->execute();
    if ( my @awaymsg = $sth->fetchrow_array ) {
      $kernel->post( 'irc_client', 'privmsg', $channel, "$wois_ ist $awaymsg[0]" );
    } else {
      $kernel->post( 'irc_client', 'privmsg', $channel, "Ich weiss nicht, wo $wois_ ist." );
    }
  } elsif( $msg =~ /(.+) ($hv) (.+)$/i ) {
    my $trigger   = $1;
    my $hilfsverb = $2;
    my $reply     = $3;

    my $sth = $dbh->prepare( "INSERT INTO knowledge ( trigger, hilfsverb, reply ) VALUES ( ?, ?, ?) " );
    $sth->execute( $trigger, $hilfsverb, $reply );
  } else {
    my $sth = $dbh->prepare( "SELECT trigger, hilfsverb, reply FROM knowledge WHERE trigger = ? ORDER BY RANDOM() LIMIT 1");
    $sth->execute( $msg );
    if( my @row = $sth->fetchrow_array ) {
      $kernel->post( 'irc_client', 'privmsg', $channel, "$row[0] $row[1] $row[2]");
    }
  }

  if( $nick ne $current_nick ) {
    $dbh->do( "UPDATE users SET lines = lines + 1,  words = words + $numwords + 1 WHERE nick = '$nick'" );
  }

  print "$channel: <$nick> $msg\n";
}

sub irc_priv_msg{
  my $kernel = $_[KERNEL];
  my $nick = (split /!/, $_[ARG0])[0];   
  my $msg = $_[ARG2];
 
  if( $msg =~ /^!(\S+)(.*)$/ ) {
    &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $nick, $msg );
  }

  if( $msg =~ /^!say (.*)$/ ) {
    $kernel->post( 'irc_client', 'privmsg', $channel, $1);  }

  print "PRIV: [$nick] $msg\n";
}

sub irc_whois{
  my $nick = (split / /, $_[ARG1])[0];
  my $host = (split / /, $_[ARG1])[2];

  if( $nick ne $current_nick ) {
    francoise_verifyuser( $nick, $host, 0 );
  }
}

sub francoise_getbasenick{
  my $nick = $_[0];


  $nick = ( split /_/, $nick )[0] || $nick;
  $nick = ( split /\|/, $nick )[0] || $nick;

  my $sth = $dbh->prepare( "SELECT nick FROM aliases WHERE alias = '$nick'" );
  $sth->execute();
  if( my @row = $sth->fetchrow_array ) {
    $nick = $row[0];
  }

  return $nick;
}

sub francoise_verifyuser {
  my $nick_   = $_[0];
  my $host    = $_[1];
  my $updtime = $_[2];
  my $kernel  = $_[3];

  my $nick = francoise_getbasenick( $nick_ );

  if( $host ) {
    my ($cnt) = $dbh->selectrow_array( "SELECT COUNT(*) FROM users WHERE nick='$nick'" );
    if ( $cnt == 0 ) {
      $dbh->do( "INSERT INTO users(id, nick, words, lines, lastlogin, lasthost) VALUES ( '', '$nick', 0, 0, now(), '$host' )");
    } else {
      $dbh->do( "UPDATE users SET lasthost = '$host'" . ( $updtime ? ", lastlogin = now()" : "" ) . " WHERE nick = '$nick'" );
    }
  } else {
    $kernel->post( 'irc_client', 'whois', $nick_);
  }

  return $nick;
}

sub francoise_help {
  my $kernel = $_[0];
  my $dest   = $_[1];

  $kernel->post( 'irc_client', 'privmsg', $dest, 'Hallo, ich bin Francoise, der freundliche Kifferchat-Bot.');
  $kernel->post( 'irc_client', 'privmsg', $dest, 'Ich kann folgende Kommandos ausfuehren:');
  $kernel->post( 'irc_client', 'privmsg', $dest, '!help      Diese Hilfe anzeigen');
  $kernel->post( 'irc_client', 'privmsg', $dest, '!stat      Informationen ueber mich ausgeben');
  $kernel->post( 'irc_client', 'privmsg', $dest, '!topten    Die aktivsten Chatter anzeigen');
  $kernel->post( 'irc_client', 'privmsg', $dest, '!topten0r  Die 13370rsten Chatter anzeigen');
  $kernel->post( 'irc_client', 'privmsg', $dest, '!forget    Einen Trigger vergessen');
}

sub francoise_stat {

}

sub francoise_topten {
  my $kernel = $_[0];
  my $dest   = $_[1]; 

  my $sth = $dbh->prepare( "SELECT words, nick FROM users ORDER BY words DESC LIMIT 10" );
  $sth->execute();
  while ( my @row = $sth->fetchrow_array ) {
    $kernel->post( 'irc_client', 'privmsg', $dest, "$row[0]  $row[1]" );
  }
}

sub francoise_topten0r {

}

sub francoise_forget {

}

sub francoise_donothing {

}

#start everything
$poe_kernel->run();