diff options
Diffstat (limited to 'bot.pl')
-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 | } |