path: root/bot.pl

#!/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("francoise");
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,
                    irc_ctcp_action => \&irc_action,
#                    _default   => \&_default,
);

sub _default {
    if ( $_[ARG0] =~ /^irc_(.*)$/ ) {
        print "IRC $1 received\n";
    }
}

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 {
  my ( $kernel, $heap, $session ) = @_[KERNEL, HEAP, SESSION ];

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

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

sub irc_connect {
  my $kernel = $_[KERNEL];
  $kernel->post(francoise=>join=>$channel);
}

sub irc_motd {
  my $msg = $_[ARG1];
  print "MOTD: $msg\n";
}

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

  $channel =~ s/[@|=] (.*?) /$1/;
  print "#-> Users on $channel [ $names ]\n";

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

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

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

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

  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, $channel ) = @_[KERNEL, ARG1];
  my $nick = (split /!/, $_[ARG0])[0];
  my $host = (split /@/, $_[ARG0])[1];

  if( $nick eq $current_nick ) {
    $kernel->post( 'francoise', '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, $msg ) = @_[KERNEL, ARG2];
  my $channel  = $_[ARG1]->[0];
  my $nick_    = (split /!/, $_[ARG0])[0];
  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 = ? AND isaway = 'true'");
    $sth->execute( $wois );
    if ( my @awaymsg = $sth->fetchrow_array ) {
      $kernel->post( 'francoise', 'privmsg', $channel, "$wois_ ist $awaymsg[0]" );
    } else {
      $kernel->post( 'francoise', '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 ($trigger, $hilfsverb, $reply) = $sth->fetchrow_array ) {
      if( $reply =~ /^<reply>(.*)$/ ) {
        $kernel->post( 'francoise', 'privmsg', $channel, "$1");
      } else {
        $kernel->post( 'francoise', 'privmsg', $channel, "$trigger $hilfsverb $reply");
      }
    }
  }

  if( $nick ne $current_nick ) {
    my $sth = $dbh->do( "UPDATE users SET lines = lines + 1,  words = words + $numwords + 1, isaway = false WHERE nick = ?" );
    $sth->execute( $nick );
  }

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

sub irc_action{
    my ( $who, $msg ) = @_[ ARG0, ARG2 ];
    my $nick_ = ( split /!/, $who )[0];

    my $nick = francoise_getbasenick( $nick_ );

    if( $msg =~ /^ist (.+)$/ ) {
      my $awaymsg = $1;
      my $sth = $dbh->prepare( "UPDATE users SET isaway = true, awaymsg = ? WHERE nick = ?");
      $sth->execute( $awaymsg, $nick );
    }
}

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

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

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

sub irc_whois{
  my ( $nick, $host ) = (split / /, $_[ARG1])[0,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 = ?" );
  $sth->execute($nick);
  if( my @row = $sth->fetchrow_array ) {
    $nick = $row[0];
  }

  return $nick;
}

sub francoise_verifyuser {
  my ( $nick_, $host, $updtime, $kernel ) = @_;
  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( 'francoise', 'whois', $nick_);
  }

  return $nick;
}

sub francoise_help {
  my ( $kernel, $dest ) = @_;

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

sub francoise_stat {

}

sub francoise_topten {
  my ($kernel, $dest ) = @_;

  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( 'francoise', 'privmsg', $dest, "$row[0]  $row[1]" );
  }
}

sub francoise_topten0r {

}

sub francoise_forget {

}

sub francoise_donothing {

}

#start everything
$poe_kernel->run();