From 4d150b570bdbde3b0d17f22bd7b86a1d29e3da0c Mon Sep 17 00:00:00 2001 From: erdgeist <> Date: Mon, 25 Jul 2005 18:37:50 +0000 Subject: bot.pl --- bot.pl | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 52 insertions(+), 15 deletions(-) diff --git a/bot.pl b/bot.pl index 97394b3..2d37864 100644 --- a/bot.pl +++ b/bot.pl @@ -7,7 +7,7 @@ use DBI; use POE; use POE::Component::IRC; -my $current_nick = "francoise"; +my $current_nick = "francoise_"; my $channel = '#test'; POE::Component::IRC->new("francoise"); @@ -37,15 +37,17 @@ my %commands = ( 'help' => \&francoise_help, 'topten' => \&francoise_topten, 'topten0r' => \&francoise_topten0r, 'forget' => \&francoise_forget, + 'alias' => \&francoise_alias, ); -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( '|', + ( '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); +my $starttime = time(); # Database connection stuff my $dbh = DBI->connect("DBI:Pg:dbname='francoise'", 'francoise', 'kiffer') @@ -142,8 +144,8 @@ sub irc_pub_msg{ my $nick = francoise_verifyuser( $nick_, "", 0, $kernel ); - if( $msg =~ /^!(\S+)(.*)$/ ) { - &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $channel, $msg ); + if( $msg =~ /^!(\S+) *(.*)$/ ) { + &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $channel, $2 ); } if( $msg =~ /^wo ist (\S+)\??$/i ) { @@ -156,13 +158,20 @@ sub irc_pub_msg{ } else { $kernel->post( 'francoise', 'privmsg', $channel, "Ich weiss nicht, wo $wois_ ist." ); } - } elsif( $msg =~ /(.+?) ($hv) (.*)$/i ) { + } elsif( $msg =~ /(?:\S: )(.+?) ($hv) (.*)$/i ) { my $trigger = $1; my $hilfsverb = $2; my $reply = $3; - my $sth = $dbh->prepare( "INSERT INTO knowledge ( trigger, hilfsverb, reply ) VALUES ( ?, ?, ?) " ); + 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 ); + } } else { my $sth = $dbh->prepare( "SELECT trigger, hilfsverb, reply FROM knowledge WHERE trigger = ? ORDER BY RANDOM() LIMIT 1"); $sth->execute( $msg ); @@ -200,8 +209,8 @@ 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 =~ /^!(\S+) *(.*)$/ ) { + &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $nick, $2 ); } if( $msg =~ /^!say (.*)$/ ) { @@ -264,10 +273,31 @@ sub francoise_help { } sub francoise_stat { + my ( $kernel, $dest ) = @_; + my $age = time() - $starttime; + my $secs = $age % 60; + my $mins = ( $age / 60 ) % 3600; + my $hours = ( $age / 3660 ) % 86400; + my $days = $age / 86400; + + my $agestring; + + if( $age < 60 ) { + $agestring = "$secs Sekunden"; + } elsif( $age < 3600 ) { + $agestring = "$mins Minuten $secs Sekunden"; + } elsif( $age < 86400) { + $agestring = "$hours Stunden $mins Minuten"; + } else { + $agestring = "$days Tage $hours Stunden"; + } + my ($usercnt) = $dbh->selectrow_array( "SELECT COUNT(*) FROM users" ); + my ($knowcnt) = $dbh->selectrow_array( "SELECT COUNT(*) FROM knowledge" ); + $kernel->post( 'francoise', 'privmsg', $dest, "Ich bin schon $agestring alt, kenne $usercnt Chatter und weiss ueber $knowcnt Dinge bescheid." ); } -sub francoise_topten { +sub francoise_topten{ my ($kernel, $dest ) = @_; my $sth = $dbh->prepare( "SELECT words, nick FROM users ORDER BY words DESC LIMIT 10" ); @@ -277,10 +307,17 @@ sub francoise_topten { } } -sub francoise_topten0r { +sub francoise_alias{ + my ($kernel, $dest, $msg ) = @_; + + my ($nick, $alias) = (split / /, $msg ); + print "$nick is also $alias \n"; } +sub francoise_topten0r { +} + sub francoise_forget { } -- cgit v1.2.3