From 8b603cb46145f151cb76df807d21cddfbbb5a9b0 Mon Sep 17 00:00:00 2001 From: erdgeist <> Date: Thu, 28 Jul 2005 01:09:55 +0000 Subject: Much perl magic added, topten0r works --- bot.pl | 279 +++++++++++++++++++++++++------------------------------------ tables.sql | 1 + 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 =~ /^(.*)$/ ) { - $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/^.*?(?: )(.*)$/$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, -- cgit v1.2.3