diff options
-rw-r--r-- | bot.pl | 63 |
1 files changed, 58 insertions, 5 deletions
@@ -47,7 +47,34 @@ my $hv = join( '|', | |||
47 | 'werde', 'wirst', 'wird', 'werden', 'werdet', | 47 | 'werde', 'wirst', 'wird', 'werden', 'werdet', |
48 | 'war', 'warst', 'waren', 'wart', | 48 | 'war', 'warst', 'waren', 'wart', |
49 | 'habe', 'hast', 'hat', 'haben', 'habt', | 49 | 'habe', 'hast', 'hat', 'haben', 'habt', |
50 | 'hatte', 'hattest', 'hatten', 'hattet' ) ); | 50 | 'hatte', 'hattest', 'hatten', 'hattet', |
51 | 'muss', 'muß', 'musst', 'mußt', 'muessen', 'müssen', 'muesst', 'mueßt', 'müsst', 'müßt' ) ); | ||
52 | |||
53 | my %pasthv = ( 'bin' => 'war', 'bist' => 'warst', 'ist' => 'war', 'is' => 'war', 'sind' => 'waren', 'seid' => 'wart', | ||
54 | 'werde' => 'bin', 'wirst' => 'bist', 'wird' => 'ist', 'werden' => 'sind', 'werdet' => 'seid', | ||
55 | 'war' => 'war', 'warst' => 'warst', 'waren' => 'waren', 'wart' => 'wart', | ||
56 | 'habe' => 'hatte', 'hast' => 'hattest', 'hat' => 'hatte', 'haben' => 'hatten', 'habt' => 'hattet', | ||
57 | 'hatte' => 'hatte', 'hattest' => 'hattest', 'hatten' => 'hatten', 'hattet' => 'hattet', | ||
58 | 'muss' => 'musste', 'muß' => 'musste', 'musst' => 'musstest', 'mußt' => 'musstest', 'muessen' => 'mussten', | ||
59 | 'müssen' => 'mussten', 'muesst' => 'musstet', 'mueßt' => 'musstet', 'müsst' => 'musstet', 'müßt' => 'musstet' ); | ||
60 | |||
61 | my %conjhv = ( 'bin' => 'wäre', 'bist' => 'wärst', 'ist' => 'wäre', 'sind' => 'wären', 'seid' => 'wärt', | ||
62 | 'werde' => 'würde', 'wirst' => 'würdest', 'wird' => 'würde', 'werden' => 'würden', 'werdet' => 'würdet', | ||
63 | 'war' => 'wäre', 'warst' => 'wärst', 'waren' => 'wären', 'wart' => 'wärt', | ||
64 | 'habe' => 'hätte', 'hast' => 'hättest', 'hat' => 'hätte', 'haben' => 'hätten', 'habt' => 'hättet', | ||
65 | 'hatte' => 'hätte', 'hattest' => 'hättest', 'hatten' => 'hätten', 'hattet' => 'hättet', | ||
66 | 'muss' => 'müsste', 'muß' => 'müsste', 'musst' => 'müsstest', 'mußt' => 'müsstest', 'muessen' => 'müssten', | ||
67 | 'müssen' => 'müssten', 'muesst' => 'müsstet', 'mueßt' => 'müsstet', 'müsst' => 'müsstet', 'müßt' => 'müsstet' ); | ||
68 | |||
69 | my %futuhv = ( 'bin' => 'werde', 'bist' => 'wirst', 'ist' => 'wird', 'sind' => 'werden', 'seid' => 'werdet', | ||
70 | 'werde' => 'werde', 'wirst' => 'wirst', 'wird' => 'wird', 'werden' => 'werden', 'werdet' => 'werdet', | ||
71 | 'war' => 'bin', 'warst' => 'bist', 'waren' => 'sind', 'wart' => 'seid', | ||
72 | 'habe' => 'habe', 'hast' => 'hast', 'hat' => 'hat', 'haben' => 'haben', 'habt' => 'habt', | ||
73 | 'hatte' => 'habe', 'hattest' => 'hast', 'hatte' => 'hat', 'hatten' => 'haben', 'hattet' => 'habt', | ||
74 | 'muss' => 'muss', 'muß' => 'muss', 'musst' => 'musst', 'mußt' => 'mußt', 'muessen' => 'muessen', | ||
75 | 'müssen' => 'müssen', 'muesst' => 'müsst', 'mueßt' => 'müsst', 'müsst' => 'müsst', 'müßt' => 'müsst' ); | ||
76 | |||
77 | |||
51 | 78 | ||
52 | my $starttime = time(); | 79 | my $starttime = time(); |
53 | 80 | ||
@@ -157,7 +184,7 @@ sub irc_pub_msg{ | |||
157 | } | 184 | } |
158 | 185 | ||
159 | #reply to whereis requests | 186 | #reply to whereis requests |
160 | if ( $msg =~ /^wo ist (\S+?)\??$/i ) { | 187 | if ( $msg =~ /^wo ist? (\S+?)\??$/i ) { |
161 | my $wois_ = $1; | 188 | my $wois_ = $1; |
162 | my $wois = francoise_getbasenick( $1 ); | 189 | my $wois = francoise_getbasenick( $1 ); |
163 | my ($awaymsg) = $dbh->selectrow_array( "SELECT awaymsg FROM users WHERE nick = ? AND isaway = 'true'", undef, $wois); | 190 | my ($awaymsg) = $dbh->selectrow_array( "SELECT awaymsg FROM users WHERE nick = ? AND isaway = 'true'", undef, $wois); |
@@ -179,6 +206,8 @@ sub irc_pub_msg{ | |||
179 | "SELECT trigger, hilfsverb, reply FROM knowledge WHERE trigger = ? ORDER BY RANDOM() LIMIT 1", undef, $msg ); | 206 | "SELECT trigger, hilfsverb, reply FROM knowledge WHERE trigger = ? ORDER BY RANDOM() LIMIT 1", undef, $msg ); |
180 | $thr =~ s/^.*?(?:<reply> )(.*)$/$1/; | 207 | $thr =~ s/^.*?(?:<reply> )(.*)$/$1/; |
181 | $thr =~ s/!who/$nick/g; | 208 | $thr =~ s/!who/$nick/g; |
209 | $thr =~ s'!date'francoise_date()'eg; | ||
210 | $thr =~ s'!time'francoise_time()'eg; | ||
182 | $kernel->post( 'francoise', 'privmsg', $channel, $thr ) if $thr; | 211 | $kernel->post( 'francoise', 'privmsg', $channel, $thr ) if $thr; |
183 | } | 212 | } |
184 | 213 | ||
@@ -191,10 +220,9 @@ sub irc_pub_msg{ | |||
191 | sub irc_action{ | 220 | sub irc_action{ |
192 | my ( $who, $msg ) = @_[ ARG0, ARG2 ]; | 221 | my ( $who, $msg ) = @_[ ARG0, ARG2 ]; |
193 | my $nick = francoise_getbasenick( ( split /!/, $who )[0] ); | 222 | my $nick = francoise_getbasenick( ( split /!/, $who )[0] ); |
194 | |||
195 | #note whereis information | 223 | #note whereis information |
196 | $dbh->do( "UPDATE users SET isaway = true, awaymsg = ? WHERE nick = ?", undef, $1, $nick ) | 224 | $dbh->do( "UPDATE users SET isaway = true, awaymsg = ? WHERE nick = ?", undef, $1, $nick ) |
197 | if( $msg =~ /^ist (.+)$/ ); | 225 | if( $msg =~ /^ist? (.+)$/ ); |
198 | } | 226 | } |
199 | 227 | ||
200 | sub irc_priv_msg{ | 228 | sub irc_priv_msg{ |
@@ -253,7 +281,11 @@ sub francoise_help { | |||
253 | } | 281 | } |
254 | 282 | ||
255 | sub francoise_stat { | 283 | sub francoise_stat { |
256 | my ( $kernel, $dest ) = @_; | 284 | my ( $kernel, $dest, $msg ) = @_; |
285 | |||
286 | francoise_userstat( $kernel, $dest, $msg ), return | ||
287 | if $msg; | ||
288 | |||
257 | my $age = time() - $starttime; | 289 | my $age = time() - $starttime; |
258 | my $secs = $age % 60; | 290 | my $secs = $age % 60; |
259 | my $mins = ( $age / 60 ) % 3600; | 291 | my $mins = ( $age / 60 ) % 3600; |
@@ -277,6 +309,16 @@ sub francoise_stat { | |||
277 | $kernel->post( 'francoise', 'privmsg', $dest, "Ich bin schon $agestring alt, kenne $usercnt Chatter und weiss ueber $knowcnt Dinge bescheid." ); | 309 | $kernel->post( 'francoise', 'privmsg', $dest, "Ich bin schon $agestring alt, kenne $usercnt Chatter und weiss ueber $knowcnt Dinge bescheid." ); |
278 | } | 310 | } |
279 | 311 | ||
312 | sub francoise_userstat{ | ||
313 | my ( $kernel, $dest, $msg ) = @_; | ||
314 | |||
315 | my $nick = francoise_getbasenick( $msg ); | ||
316 | my @userstat = $dbh->selectrow_array( "SELECT words, lines, w0rds, isaway, awaymsg FROM users WHERE nick = ?", undef, $nick ); | ||
317 | my $awaymsg = $userstat[3] ? " $nick ist momentan $userstat[4]." : ""; | ||
318 | |||
319 | $kernel->post( 'francoise', 'privmsg', $dest, "$nick hat schon $userstat[0] Worte in $userstat[1] Zeilen von sich gegeben und $userstat[2] mal in den Kanal ge0red.$awaymsg"); | ||
320 | } | ||
321 | |||
280 | sub francoise_topten{ | 322 | sub francoise_topten{ |
281 | my ($kernel, $dest ) = @_; | 323 | my ($kernel, $dest ) = @_; |
282 | 324 | ||
@@ -325,5 +367,16 @@ sub francoise_forget { | |||
325 | sub francoise_donothing { | 367 | sub francoise_donothing { |
326 | } | 368 | } |
327 | 369 | ||
370 | sub francoise_time { | ||
371 | my ( $sec,$min,$hour) = localtime(time); | ||
372 | return sprintf "%02d:%02d:%02d", $hour, $min, $sec; | ||
373 | } | ||
374 | |||
375 | my @mons = ('Januar','Februar','März','April','Mai','Juni','Juli','August','September','Oktober','November','Dezember'); | ||
376 | sub francoise_date { | ||
377 | my ($sec,$min,$hour,$mday,$mon) = localtime(time); | ||
378 | return sprintf "%02d. %s", $mday, $mons[$mon]; | ||
379 | } | ||
380 | |||
328 | #start everything | 381 | #start everything |
329 | $poe_kernel->run(); | 382 | $poe_kernel->run(); |