summaryrefslogtreecommitdiff
path: root/bot.pl
diff options
context:
space:
mode:
Diffstat (limited to 'bot.pl')
-rw-r--r--bot.pl67
1 files 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;
7use POE; 7use POE;
8use POE::Component::IRC; 8use POE::Component::IRC;
9 9
10my $current_nick = "francoise"; 10my $current_nick = "francoise_";
11my $channel = '#test'; 11my $channel = '#test';
12 12
13POE::Component::IRC->new("francoise"); 13POE::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
42my @hilfsverb = ( 'bin', 'bist', 'ist', 'is', 'sind', 'seid', 43my $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
48my $hv = join( '|', @hilfsverb); 50my $starttime = time();
49 51
50# Database connection stuff 52# Database connection stuff
51my $dbh = DBI->connect("DBI:Pg:dbname='francoise'", 'francoise', 'kiffer') 53my $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
266sub francoise_stat { 275sub 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
270sub francoise_topten { 300sub 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
280sub francoise_topten0r { 310sub 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
318sub francoise_topten0r {
319}
320
284sub francoise_forget { 321sub francoise_forget {
285 322
286} 323}