diff options
| -rw-r--r-- | bot.pl | 67 |
1 files changed, 52 insertions, 15 deletions
| @@ -7,7 +7,7 @@ use DBI; | |||
| 7 | use POE; | 7 | use POE; |
| 8 | use POE::Component::IRC; | 8 | use POE::Component::IRC; |
| 9 | 9 | ||
| 10 | my $current_nick = "francoise"; | 10 | my $current_nick = "francoise_"; |
| 11 | my $channel = '#test'; | 11 | my $channel = '#test'; |
| 12 | 12 | ||
| 13 | POE::Component::IRC->new("francoise"); | 13 | POE::Component::IRC->new("francoise"); |
| @@ -37,15 +37,17 @@ my %commands = ( 'help' => \&francoise_help, | |||
| 37 | 'topten' => \&francoise_topten, | 37 | 'topten' => \&francoise_topten, |
| 38 | 'topten0r' => \&francoise_topten0r, | 38 | 'topten0r' => \&francoise_topten0r, |
| 39 | 'forget' => \&francoise_forget, | 39 | 'forget' => \&francoise_forget, |
| 40 | 'alias' => \&francoise_alias, | ||
| 40 | ); | 41 | ); |
| 41 | 42 | ||
| 42 | my @hilfsverb = ( 'bin', 'bist', 'ist', 'is', 'sind', 'seid', | 43 | my $hv = join( '|', |
| 43 | 'werde', 'wirst', 'wird', 'werden', 'werdet', | 44 | ( 'bin', 'bist', 'ist', 'is', 'sind', 'seid', |
| 44 | 'war', 'warst', 'waren', 'wart', | 45 | 'werde', 'wirst', 'wird', 'werden', 'werdet', |
| 45 | 'habe', 'hast', 'hat', 'haben', 'habt', | 46 | 'war', 'warst', 'waren', 'wart', |
| 46 | 'hatte', 'hattest', 'hatten', 'hattet' ); | 47 | 'habe', 'hast', 'hat', 'haben', 'habt', |
| 48 | 'hatte', 'hattest', 'hatten', 'hattet' ) ); | ||
| 47 | 49 | ||
| 48 | my $hv = join( '|', @hilfsverb); | 50 | my $starttime = time(); |
| 49 | 51 | ||
| 50 | # Database connection stuff | 52 | # Database connection stuff |
| 51 | my $dbh = DBI->connect("DBI:Pg:dbname='francoise'", 'francoise', 'kiffer') | 53 | my $dbh = DBI->connect("DBI:Pg:dbname='francoise'", 'francoise', 'kiffer') |
| @@ -142,8 +144,8 @@ sub irc_pub_msg{ | |||
| 142 | 144 | ||
| 143 | my $nick = francoise_verifyuser( $nick_, "", 0, $kernel ); | 145 | my $nick = francoise_verifyuser( $nick_, "", 0, $kernel ); |
| 144 | 146 | ||
| 145 | if( $msg =~ /^!(\S+)(.*)$/ ) { | 147 | if( $msg =~ /^!(\S+) *(.*)$/ ) { |
| 146 | &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $channel, $msg ); | 148 | &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $channel, $2 ); |
| 147 | } | 149 | } |
| 148 | 150 | ||
| 149 | if( $msg =~ /^wo ist (\S+)\??$/i ) { | 151 | if( $msg =~ /^wo ist (\S+)\??$/i ) { |
| @@ -156,13 +158,20 @@ sub irc_pub_msg{ | |||
| 156 | } else { | 158 | } else { |
| 157 | $kernel->post( 'francoise', 'privmsg', $channel, "Ich weiss nicht, wo $wois_ ist." ); | 159 | $kernel->post( 'francoise', 'privmsg', $channel, "Ich weiss nicht, wo $wois_ ist." ); |
| 158 | } | 160 | } |
| 159 | } elsif( $msg =~ /(.+?) ($hv) (.*)$/i ) { | 161 | } elsif( $msg =~ /(?:\S: )(.+?) ($hv) (.*)$/i ) { |
| 160 | my $trigger = $1; | 162 | my $trigger = $1; |
| 161 | my $hilfsverb = $2; | 163 | my $hilfsverb = $2; |
| 162 | my $reply = $3; | 164 | my $reply = $3; |
| 163 | 165 | ||
| 164 | my $sth = $dbh->prepare( "INSERT INTO knowledge ( trigger, hilfsverb, reply ) VALUES ( ?, ?, ?) " ); | 166 | my $sth = $dbh->prepare( "SELECT COUNT(*) FROM knowledge WHERE trigger = ? AND hilfsverb = ? AND reply = ?;" ); |
| 165 | $sth->execute( $trigger, $hilfsverb, $reply ); | 167 | $sth->execute( $trigger, $hilfsverb, $reply ); |
| 168 | my ($cnt) = $sth->fetchrow_array; | ||
| 169 | print "$cnt \n"; | ||
| 170 | |||
| 171 | if( $cnt == 0 ) { | ||
| 172 | $sth = $dbh->prepare( "INSERT INTO knowledge ( trigger, hilfsverb, reply ) VALUES ( ?, ?, ?) " ); | ||
| 173 | $sth->execute( $trigger, $hilfsverb, $reply ); | ||
| 174 | } | ||
| 166 | } else { | 175 | } else { |
| 167 | my $sth = $dbh->prepare( "SELECT trigger, hilfsverb, reply FROM knowledge WHERE trigger = ? ORDER BY RANDOM() LIMIT 1"); | 176 | my $sth = $dbh->prepare( "SELECT trigger, hilfsverb, reply FROM knowledge WHERE trigger = ? ORDER BY RANDOM() LIMIT 1"); |
| 168 | $sth->execute( $msg ); | 177 | $sth->execute( $msg ); |
| @@ -200,8 +209,8 @@ sub irc_priv_msg{ | |||
| 200 | my ( $kernel, $msg ) = @_[KERNEL, ARG2]; | 209 | my ( $kernel, $msg ) = @_[KERNEL, ARG2]; |
| 201 | my $nick = (split /!/, $_[ARG0])[0]; | 210 | my $nick = (split /!/, $_[ARG0])[0]; |
| 202 | 211 | ||
| 203 | if( $msg =~ /^!(\S+)(.*)$/ ) { | 212 | if( $msg =~ /^!(\S+) *(.*)$/ ) { |
| 204 | &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $nick, $msg ); | 213 | &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $nick, $2 ); |
| 205 | } | 214 | } |
| 206 | 215 | ||
| 207 | if( $msg =~ /^!say (.*)$/ ) { | 216 | if( $msg =~ /^!say (.*)$/ ) { |
| @@ -264,10 +273,31 @@ sub francoise_help { | |||
| 264 | } | 273 | } |
| 265 | 274 | ||
| 266 | sub francoise_stat { | 275 | sub francoise_stat { |
| 276 | my ( $kernel, $dest ) = @_; | ||
| 277 | my $age = time() - $starttime; | ||
| 278 | my $secs = $age % 60; | ||
| 279 | my $mins = ( $age / 60 ) % 3600; | ||
| 280 | my $hours = ( $age / 3660 ) % 86400; | ||
| 281 | my $days = $age / 86400; | ||
| 282 | |||
| 283 | my $agestring; | ||
| 284 | |||
| 285 | if( $age < 60 ) { | ||
| 286 | $agestring = "$secs Sekunden"; | ||
| 287 | } elsif( $age < 3600 ) { | ||
| 288 | $agestring = "$mins Minuten $secs Sekunden"; | ||
| 289 | } elsif( $age < 86400) { | ||
| 290 | $agestring = "$hours Stunden $mins Minuten"; | ||
| 291 | } else { | ||
| 292 | $agestring = "$days Tage $hours Stunden"; | ||
| 293 | } | ||
| 267 | 294 | ||
| 295 | my ($usercnt) = $dbh->selectrow_array( "SELECT COUNT(*) FROM users" ); | ||
| 296 | my ($knowcnt) = $dbh->selectrow_array( "SELECT COUNT(*) FROM knowledge" ); | ||
| 297 | $kernel->post( 'francoise', 'privmsg', $dest, "Ich bin schon $agestring alt, kenne $usercnt Chatter und weiss ueber $knowcnt Dinge bescheid." ); | ||
| 268 | } | 298 | } |
| 269 | 299 | ||
| 270 | sub francoise_topten { | 300 | sub francoise_topten{ |
| 271 | my ($kernel, $dest ) = @_; | 301 | my ($kernel, $dest ) = @_; |
| 272 | 302 | ||
| 273 | my $sth = $dbh->prepare( "SELECT words, nick FROM users ORDER BY words DESC LIMIT 10" ); | 303 | my $sth = $dbh->prepare( "SELECT words, nick FROM users ORDER BY words DESC LIMIT 10" ); |
| @@ -277,10 +307,17 @@ sub francoise_topten { | |||
| 277 | } | 307 | } |
| 278 | } | 308 | } |
| 279 | 309 | ||
| 280 | sub francoise_topten0r { | 310 | sub francoise_alias{ |
| 311 | my ($kernel, $dest, $msg ) = @_; | ||
| 312 | |||
| 313 | my ($nick, $alias) = (split / /, $msg ); | ||
| 314 | print "$nick is also $alias \n"; | ||
| 281 | 315 | ||
| 282 | } | 316 | } |
| 283 | 317 | ||
| 318 | sub francoise_topten0r { | ||
| 319 | } | ||
| 320 | |||
| 284 | sub francoise_forget { | 321 | sub francoise_forget { |
| 285 | 322 | ||
| 286 | } | 323 | } |
