Much perl magic added, topten0r works

2 files changed, 113 insertions, 167 deletions

diff --git a/bot.pl b/bot.pl
index d426602..ea7a831 100644
--- a/bot.pl
+++ b/bot.pl
@@ -7,8 +7,8 @@ use DBI;
 use POE;
 use POE::Component::IRC;
 
-my $current_nick = 'francoise';
-my $channel      = '#kiffer.de';
+my $current_nick = 'francoise_';
+my $channel      = '#test';
 
 POE::Component::IRC->new("francoise");
 POE::Session->new ( _start     => \&irc_start,
@@ -23,14 +23,9 @@ POE::Session->new ( _start     => \&irc_start,
                     irc_public => \&irc_pub_msg,
                     irc_msg    => \&irc_priv_msg,
                     irc_ctcp_action => \&irc_action,
-#                    _default   => \&_default,
+#                   _default   => \&irc_default,
 );
 
-sub _default {
-    if ( $_[ARG0] =~ /^irc_(.*)$/ ) {
-        print "IRC $1 received\n";
-    }
-}
 
 my %commands = ( 'help'     => \&francoise_help,
                  'stat'     => \&francoise_stat,
@@ -75,27 +70,25 @@ sub irc_start {
                 );
 }
 
-sub irc_connect {
-  my $kernel = $_[KERNEL];
-  $kernel->post(francoise=>join=>$channel);
-}
-
-sub irc_motd {
-  my $msg = $_[ARG1];
-  print "MOTD: $msg\n";
-}
+# minifunctions, console output only
+sub irc_connect { $_[KERNEL]->post(francoise=>join=>$channel); }
+sub irc_motd    { my $msg = $_[ARG1]; print "MOTD: $msg\n"; }
+sub irc_part    { my $channel = $_[ARG1]; my $nick = (split /!/, $_[ARG0])[0]; print "#-> $nick has parted $channel\n"; }
+sub irc_quit    { my $nick = $_[ARG0]; my $reason = $_[ARG1]; print "#-> $nick has quit ($reason)\n"; }
+sub irc_default { print "IRC $1 received\n" if ( $_[ARG0] =~ /^irc_(.*)$/ ); }
 
+#names list on join, check all users
 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) {
+  for my $user ( split ' ', $names ) {
     $user =~ s/^[@%+]//;
     $kernel->post( 'francoise', 'whois', $user);
   }
+
+  $channel =~ s/[@|=] (.*?) /$1/;
+  print "#-> Users on $channel [ $names ]\n";
 }
 
 #nick change
@@ -106,144 +99,112 @@ sub irc_nick {
   my $oldnick = francoise_getbasenick( $oldnick_ );
   my $newnick = francoise_getbasenick( $newnick_ );
 
-  if( $newnick_ ne $current_nick && $newnick ne $oldnick ) {
-    francoise_verifyuser( $newnick_, '', 0, $kernel );
-  }
+  francoise_verifyuser( $newnick_, '', 0, $kernel )
+    if $newnick_ ne $current_nick && $newnick ne $oldnick;
 
   print "#-> $oldnick_ is now known as $newnick_\n";
 }
 
-#user parted
-sub irc_part {
-  my $channel = $_[ARG1];
-  if ( $_[ARG0] =~ /(.+)!~(.+)@(.+)/ ) {
-    my $nick = $1; my $user = $2; my $host = $3;
-    print "#-> $nick has parted $channel\n";
-  }
-}
-
 #user joined
 sub irc_join {
   my ( $kernel, $channel ) = @_[KERNEL, ARG1];
 
-  if ( $_[ARG0] =~ /(.+)!~(.+)@(.+)/ ) {
-    my $nick = $1; my $user = $2; my $host = $3;
+  $_[ARG0] =~ /(.+)!~(.+)@(.+)/ or return;
+  my ( $nick, $user, $host ) = ($1,$2,$3);
 
-    if( $nick eq $current_nick ) {
-      $kernel->post( 'francoise', 'privmsg', $channel, 'Hier bin ich!');
-    } else {
-      if( $host eq 'jamaica.kiffer.de' ) {
-        if( $jamaica{$user} && time() - $jamaicat{$user} < $jamaicatimeout ) {
-          $kernel->post( 'francoise', 'privmsg', $channel, "Ich glaub ja, $jamaica{$user} und $nick kennen sich." )
-        }
-        $jamaica{$user} = $nick; $jamaicat{$user} = time();
-      }
+  $kernel->post( 'francoise', 'privmsg', $channel, 'Hier bin ich!'), return
+    if $nick eq $current_nick;
 
-      francoise_verifyuser( $nick, $host, 1 );
-    }
+  francoise_verifyuser( $nick, $host, 1 );
+  return unless $host eq 'jamaica.kiffer.de';
 
-    print "#-> $nick has joined $channel\n";
-  }
-}
+  $kernel->post( 'francoise', 'privmsg', $channel, "Ich glaub ja, $jamaica{$user} und $nick kennen sich.")
+    if $jamaica{$user} && $nick ne $jamaica{$user} && time() - $jamaicat{$user} < $jamaicatimeout;
+  $jamaica{$user} = $nick; $jamaicat{$user} = time();
 
-#user quit
-sub irc_quit {
-  my $nick = $_[ARG0];
-  my $reason = $_[ARG1];
-  print "#-> $nick has quit ($reason)\n";
+  print "#-> $nick has joined $channel\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 $w0rds    = 0;
 
+  #tidy nick and tidy msg from dest nick
   my $nick = francoise_verifyuser( $nick_, "", 0, $kernel );
+  $msg =~ s/^\S+: +//;
 
-  if( $msg =~ /^!(\S+) *(.*)$/ ) {
-    &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $channel, $2 );
-  }
+  #execute commands
+  &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $channel, $2 )
+    if $msg =~ /^!(\S+) *(.*)$/;
+
+  #update dictionary
+  my $sth_lookup = $dbh->prepare( "SELECT COUNT(*) FROM words WHERE word = ?");
+  my $sth_insert = $dbh->prepare( "INSERT INTO words ( word, is_0r, is_action ) VALUES ( ?, ?, ? )");
 
   for my $word ( @words ) {
     my $is0r = 'false'; my $isact = 'false';
-    my $sth = $dbh->prepare( "SELECT COUNT(*) FROM words WHERE word = ?");
-    $sth->execute( $word );
-    next if (($sth->fetchrow_array)) > 0;
-    $is0r = 'true' if $word =~ /0r/;
-    $isact = 'true' if $word =~ /^\*.*\*$/;
-    $sth = $dbh->prepare("INSERT INTO words ( word, is_0r, is_action ) VALUES ( ?, ?, ? )");
-    $sth->execute( $word, $is0r, $isact );
+    $sth_lookup->execute( $word );
+    $is0r  = 'true', $w0rds++ if $word =~ /0r/;
+    $isact = 'true'           if $word =~ /^\*.*\*$/;
+    $sth_insert->execute( $word, $is0r, $isact )
+      unless ($sth_lookup->fetchrow_array)[0];
   }
 
+  #reply to whereis requests
   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 =~ /^(?:\S+: )?(.+?)\s+($hv)\s+(.*)$/i ) {
-    my $trigger   = $1;
-    my $hilfsverb = $2;
-    my $reply     = $3;
-
-    my $sth = $dbh->prepare( "SELECT COUNT(*) FROM knowledge WHERE trigger = ? AND hilfsverb = ? AND reply = ?;" );
-    $sth->execute( $trigger, $hilfsverb, $reply );
-    my ($cnt) = $sth->fetchrow_array;
-    print "$cnt \n";
-
-    if( $cnt == 0 ) {
-      $sth = $dbh->prepare( "INSERT INTO knowledge ( trigger, hilfsverb, reply ) VALUES ( ?, ?, ?) " );
-      $sth->execute( $trigger, $hilfsverb, $reply );
-    }
+    my ($awaymsg) = $dbh->selectrow_array( "SELECT awaymsg FROM users WHERE nick = ? AND isaway = 'true'", undef, $wois);
+
+    $kernel->post( 'francoise', 'privmsg', $channel, $awaymsg ? "$wois_ ist $awaymsg" : "Ich weiss nicht, wo $wois_ ist." );
+
+  } elsif( $msg =~ /^(.+?)\s+($hv)\s+(.*)$/i ) {
+    #learn some new knowledge
+    my ( $trigger, $hilfsverb, $reply ) = ($1,$2,$3);
+
+    $dbh->do( "INSERT INTO knowledge ( trigger, hilfsverb, reply ) VALUES ( ?, ?, ?) ", undef, $trigger, $hilfsverb, $reply )
+      unless ($dbh->selectrow_array(
+       "SELECT COUNT(*) FROM knowledge WHERE trigger = ? AND hilfsverb = ? AND reply = ?", undef, $trigger, $hilfsverb, $reply
+      ))[0];
+
   } 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");
-      }
-    }
+    #search in our knowledge
+    my $thr = join ' ', $dbh->selectrow_array(
+        "SELECT trigger, hilfsverb, reply FROM knowledge WHERE trigger = ? ORDER BY RANDOM() LIMIT 1", undef, $msg );
+    $thr =~ s/^.*?(?:<reply> )(.*)$/$1/;
+    $kernel->post( 'francoise', 'privmsg', $channel, $thr ) if $thr;
   }
 
-  if( $nick ne $current_nick ) {
-    my $sth = $dbh->prepare( "UPDATE users SET lines = lines + 1,  words = words + $numwords + 1, isaway = false WHERE nick = ?" );
-    $sth->execute( $nick );
-  }
+  #credit word and line count to user
+  $dbh->do( "UPDATE users SET lines = lines + 1, words = words + ?, w0rds = w0rds + ?, isaway = false WHERE nick = ?",
+    undef, $#words + 1, $w0rds, $nick ) if $nick ne $current_nick;
 
   print "$channel: <$nick> $msg\n";
 }
 
 sub irc_action{
-    my ( $who, $msg ) = @_[ ARG0, ARG2 ];
-    my $nick_ = ( split /!/, $who )[0];
-
-    my $nick = francoise_getbasenick( $nick_ );
+  my ( $who, $msg ) = @_[ ARG0, ARG2 ];
+  my $nick = francoise_getbasenick( ( split /!/, $who )[0] );
 
-    if( $msg =~ /^ist (.+)$/ ) {
-      my $awaymsg = $1;
-      my $sth = $dbh->prepare( "UPDATE users SET isaway = true, awaymsg = ? WHERE nick = ?");
-      $sth->execute( $awaymsg, $nick );
-    }
+  #note whereis information
+  $dbh->do( "UPDATE users SET isaway = true, awaymsg = ? WHERE nick = ?", undef, $1, $nick )
+    if( $msg =~ /^ist (.+)$/ );
 }
 
 sub irc_priv_msg{
   my ( $kernel, $msg ) = @_[KERNEL, ARG2];
   my $nick = (split /!/, $_[ARG0])[0];   
  
-  if( $msg =~ /^!(\S+) *(.*)$/ ) {
-    &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $nick, $2 );
-  }
+  &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $nick, $2 )
+    if( $msg =~ /^!(\S+) *(.*)$/ );
 
-  if( $msg =~ /^!say (.*)$/ ) {
-    $kernel->post( 'francoise', 'privmsg', $channel, $1);  }
+  #todo: hide that better, the lady is no puppet on a string
+  $kernel->post( 'francoise', 'privmsg', $channel, $1)
+    if( $msg =~ /^!say (.*)$/ );
 
   print "PRIV: [$nick] $msg\n";
 }
@@ -251,38 +212,28 @@ sub irc_priv_msg{
 sub irc_whois{
   my ( $nick, $host ) = (split / /, $_[ARG1])[0,2];
 
-  if( $nick ne $current_nick ) {
-    francoise_verifyuser( $nick, $host, 0 );
-  }
+  francoise_verifyuser( $nick, $host, 0 )
+    if( $nick ne $current_nick );
 }
 
 sub francoise_getbasenick{
-  my $nick = $_[0];
-  $nick =~ s/^(.+)[_|^-].*/$1/;
-
-  my $sth = $dbh->prepare( "SELECT nick FROM aliases WHERE alias = ?" );
-  $sth->execute($nick);
-  if( my @row = $sth->fetchrow_array ) {
-    $nick = $row[0];
-  }
-
-  return $nick;
+  my $nick = $_[0]; $nick =~ s/^(.+?)[_|^-].*/$1/;
+  return ($dbh->selectrow_array( "SELECT nick FROM aliases WHERE alias = ?", undef, $nick ))[0] || $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_);
-  }
+  $kernel->post( 'francoise', 'whois', $nick_), return $nick
+    unless $host;
+
+  my ($cnt) = $dbh->selectrow_array( "SELECT COUNT(*) FROM users WHERE nick=?", undef, $nick );
+
+  $dbh->do( "INSERT INTO users(id, nick, words, lines, lastlogin, lasthost) VALUES ( '', ?, 0, 0, now(), ? )", undef, $nick, $host)
+    unless $cnt;
+  $dbh->do( "UPDATE users SET lasthost = ?" . ( $updtime ? ", lastlogin = now()" : "" ) . " WHERE nick = ?", undef, $host, $nick )
+    if $cnt;
 
   return $nick;
 }
@@ -304,7 +255,7 @@ sub francoise_stat {
   my $age   = time() - $starttime;
   my $secs  =   $age % 60;
   my $mins  = ( $age / 60   ) % 3600;
-  my $hours = ( $age / 3660 ) % 86400;
+  my $hours = ( $age / 3600 ) % 86400;
   my $days  =   $age / 86400;
 
   my $agestring;
@@ -327,55 +278,49 @@ sub francoise_stat {
 sub francoise_topten{
   my ($kernel, $dest ) = @_;
 
-  my $sth = $dbh->prepare( "SELECT words, nick FROM users ORDER BY words DESC LIMIT 10" );
+  my $sth = $dbh->prepare( "SELECT words, nick FROM users WHERE words > 0 ORDER BY words DESC LIMIT 10" );
   $sth->execute();
-  while ( my @row = $sth->fetchrow_array ) {
-    $kernel->post( 'francoise', 'privmsg', $dest, "$row[0]  $row[1]" );
+  while ( my ($words, $nick) = $sth->fetchrow_array ) {
+    $kernel->post( 'francoise', 'privmsg', $dest, "$words  $nick" );
   }
 }
 
-sub francoise_alias{
-  my ($kernel, $dest, $msg ) = @_;
+sub francoise_topten0r {
+  my ($kernel, $dest ) = @_;
 
-  my ($nick, $alias) = (split / /, $msg );
+  my $sth = $dbh->prepare( "SELECT w0rds, nick FROM users WHERE w0rds > 0 ORDER BY w0rds DESC LIMIT 10" );
+  $sth->execute();
 
-  my $sth = $dbh->prepare( "SELECT nick FROM aliases WHERE alias = ?" );
-  $sth->execute( $nick );
-  if( my ($tmp) = $sth->fetchrow_array ) {
-    $alias = $nick; $nick = $tmp;
+  while ( my ($w0rds, $nick ) = $sth->fetchrow_array ) {
+    $kernel->post( 'francoise', 'privmsg', $dest, "$w0rds  $nick" );
   }
+}
 
-  $sth = $dbh->prepare( "SELECT COUNT(*) FROM aliases WHERE nick = ? AND alias = ?" );
-  $sth->execute( $nick, $alias);
-  return if( ($sth->fetchrow_array)[0] > 0 );
-
-  $sth = $dbh->prepare( "SELECT words, lines FROM users WHERE nick = ?");
-  $sth->execute($nick); my @userrow = $sth->fetchrow_array;
-  $sth->execute($alias); my @aliasrow = $sth->fetchrow_array;
+sub francoise_alias{
+  my ($kernel, $dest, $msg ) = @_;
+  my ($nick, $alias) = (split / /, $msg );
 
-  print "@userrow @aliasrow \n";
+  my ($tmp) = $dbh->selectrow_array( "SELECT nick FROM aliases WHERE alias = ?", undef, $nick );
+  $alias = $nick, $nick = $tmp if $tmp;
 
-  if( @userrow && @aliasrow ) {
-    $sth = $dbh->prepare( "UPDATE users SET isaway = false, words = ?, lines = ? WHERE nick = ?" );
-    $sth->execute( $userrow[0]+$aliasrow[0], $userrow[1]+$aliasrow[1], $nick );
+  ($tmp) = $dbh->selectrow_array( "SELECT COUNT(*) FROM aliases WHERE nick = ? AND alias = ?", undef, $nick, $alias );
+  return if $tmp;
 
-    $sth = $dbh->prepare( "INSERT INTO aliases ( nick, alias ) VALUES ( ?, ? )" );
-    $sth->execute($nick, $alias);
+  my ( $usw, $usl, $us0 ) = $dbh->selectrow_array( "SELECT words, lines, w0rds FROM users WHERE nick = ?", undef, $nick );
+  my ( $alw, $all, $al0 ) = $dbh->selectrow_array( "SELECT words, lines, w0rds FROM users WHERE nick = ?", undef, $alias);
 
-    $sth = $dbh->prepare( "DELETE FROM users WHERE nick = ?" );
-    $sth->execute( $alias );
+  if( $alw || $all ) {
+    $dbh->do( "UPDATE users SET isaway = false, words = ?, lines = ?, w0rds = ? WHERE nick = ?",
+      undef, $usw+$alw, $usl+$all, $us0 + $al0, $nick );
+    $dbh->do( "INSERT INTO aliases ( nick, alias ) VALUES ( ?, ? )", undef, $nick, $alias );
+    $dbh->do( "DELETE FROM users WHERE nick = ?", undef, $alias );
   }
 }
 
-sub francoise_topten0r {
-}
-
 sub francoise_forget {
-
 }
 
 sub francoise_donothing {
-
 }
 
 #start everything
diff --git a/tables.sql b/tables.sql
index 27bdc4f..ed1e842 100644
--- a/tables.sql
+++ b/tables.sql
@@ -13,6 +13,7 @@ create table users (
 
         words           integer,
         lines           integer,
+        w0rds           integer,
 
         isaway          bool default false,
         awaymsg         text,