diff options
| -rw-r--r-- | bot.pl | 63 |
1 files changed, 53 insertions, 10 deletions
| @@ -33,6 +33,14 @@ my %commands = ( 'help' => \&francoise_help, | |||
| 33 | 'forget' => \&francoise_forget, | 33 | 'forget' => \&francoise_forget, |
| 34 | ); | 34 | ); |
| 35 | 35 | ||
| 36 | my @hilfsverb = ( 'bin', 'bist', 'ist', 'is', 'sind', 'seid', | ||
| 37 | 'werde', 'wirst', 'wird', 'werden', 'werdet', | ||
| 38 | 'war', 'warst', 'waren', 'wart', | ||
| 39 | 'habe', 'hast', 'hat', 'haben', 'habt', | ||
| 40 | 'hatte', 'hattest', 'hatten', 'hattet' ); | ||
| 41 | |||
| 42 | my $hv = join( '|', @hilfsverb); | ||
| 43 | |||
| 36 | # Database connection stuff | 44 | # Database connection stuff |
| 37 | my $dbh = DBI->connect("DBI:Pg:dbname='francoise'", 'francoise', 'kiffer') | 45 | my $dbh = DBI->connect("DBI:Pg:dbname='francoise'", 'francoise', 'kiffer') |
| 38 | or die "ohoh, datenbank b0rken: $!"; | 46 | or die "ohoh, datenbank b0rken: $!"; |
| @@ -84,14 +92,17 @@ sub irc_names { | |||
| 84 | 92 | ||
| 85 | #nick change | 93 | #nick change |
| 86 | sub irc_nick { | 94 | sub irc_nick { |
| 87 | my $oldnick = (split /!/, $_[ARG0])[0]; | 95 | my $oldnick_ = (split /!/, $_[ARG0])[0]; |
| 88 | my $newnick = $_[ARG1]; | 96 | my $newnick_ = $_[ARG1]; |
| 97 | |||
| 98 | my $oldnick = francoise_getbasenick( $oldnick_ ); | ||
| 99 | my $newnick = francoise_getbasenick( $newnick_ ); | ||
| 89 | 100 | ||
| 90 | if( $newnick ne $current_nick ) { | 101 | if( $newnick_ ne $current_nick && $newnick ne $oldnick ) { |
| 91 | $dbh->do( "UPDATE users SET nick = '$newnick' WHERE nick = '$oldnick'" ); | 102 | francoise_verifyuser( $newnick_, '', 0 ); |
| 92 | } | 103 | } |
| 93 | 104 | ||
| 94 | print "#-> $oldnick is now known as $newnick\n"; | 105 | print "#-> $oldnick_ is now known as $newnick_\n"; |
| 95 | } | 106 | } |
| 96 | 107 | ||
| 97 | #user parted | 108 | #user parted |
| @@ -134,15 +145,15 @@ sub irc_pub_msg{ | |||
| 134 | my @words = (split / /, $msg); | 145 | my @words = (split / /, $msg); |
| 135 | my $numwords = $#words; | 146 | my $numwords = $#words; |
| 136 | 147 | ||
| 148 | my $nick = francoise_verifyuser( $nick_, "", 0, $kernel ); | ||
| 149 | |||
| 137 | if( $msg =~ /^!(\S+)(.*)$/ ) { | 150 | if( $msg =~ /^!(\S+)(.*)$/ ) { |
| 138 | &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $channel, $msg ); | 151 | &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $channel, $msg ); |
| 139 | } | 152 | } |
| 140 | 153 | ||
| 141 | my $nick = francoise_verifyuser( $nick_, "", 0, $kernel ); | 154 | if( $msg =~ /^wo ist (\S+)\??$/i ) { |
| 142 | |||
| 143 | if( $msg =~ /^wo ist (\S+)/i ) { | ||
| 144 | my $wois_ = $1; | 155 | my $wois_ = $1; |
| 145 | my $wois = ( split /_/, $1 )[0] || $1; | 156 | my $wois = francoise_getbasenick( $1 ); |
| 146 | my $sth = $dbh->prepare( "SELECT awaymsg FROM users WHERE nick = '$wois' AND isaway = 'true'"); | 157 | my $sth = $dbh->prepare( "SELECT awaymsg FROM users WHERE nick = '$wois' AND isaway = 'true'"); |
| 147 | $sth->execute(); | 158 | $sth->execute(); |
| 148 | if ( my @awaymsg = $sth->fetchrow_array ) { | 159 | if ( my @awaymsg = $sth->fetchrow_array ) { |
| @@ -150,6 +161,19 @@ sub irc_pub_msg{ | |||
| 150 | } else { | 161 | } else { |
| 151 | $kernel->post( 'irc_client', 'privmsg', $channel, "Ich weiss nicht, wo $wois_ ist." ); | 162 | $kernel->post( 'irc_client', 'privmsg', $channel, "Ich weiss nicht, wo $wois_ ist." ); |
| 152 | } | 163 | } |
| 164 | } elsif( $msg =~ /(.+) ($hv) (.+)$/i ) { | ||
| 165 | my $trigger = $1; | ||
| 166 | my $hilfsverb = $2; | ||
| 167 | my $reply = $3; | ||
| 168 | |||
| 169 | my $sth = $dbh->prepare( "INSERT INTO knowledge ( trigger, hilfsverb, reply ) VALUES ( ?, ?, ?) " ); | ||
| 170 | $sth->execute( $trigger, $hilfsverb, $reply ); | ||
| 171 | } else { | ||
| 172 | my $sth = $dbh->prepare( "SELECT trigger, hilfsverb, reply FROM knowledge WHERE trigger = ? ORDER BY RANDOM() LIMIT 1"); | ||
| 173 | $sth->execute( $msg ); | ||
| 174 | if( my @row = $sth->fetchrow_array ) { | ||
| 175 | $kernel->post( 'irc_client', 'privmsg', $channel, "$row[0] $row[1] $row[2]"); | ||
| 176 | } | ||
| 153 | } | 177 | } |
| 154 | 178 | ||
| 155 | if( $nick ne $current_nick ) { | 179 | if( $nick ne $current_nick ) { |
| @@ -168,6 +192,9 @@ sub irc_priv_msg{ | |||
| 168 | &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $nick, $msg ); | 192 | &{$commands{ $1 } || \&francoise_donothing } ( $kernel, $nick, $msg ); |
| 169 | } | 193 | } |
| 170 | 194 | ||
| 195 | if( $msg =~ /^!say (.*)$/ ) { | ||
| 196 | $kernel->post( 'irc_client', 'privmsg', $channel, $1); } | ||
| 197 | |||
| 171 | print "PRIV: [$nick] $msg\n"; | 198 | print "PRIV: [$nick] $msg\n"; |
| 172 | } | 199 | } |
| 173 | 200 | ||
| @@ -180,13 +207,29 @@ sub irc_whois{ | |||
| 180 | } | 207 | } |
| 181 | } | 208 | } |
| 182 | 209 | ||
| 210 | sub francoise_getbasenick{ | ||
| 211 | my $nick = $_[0]; | ||
| 212 | |||
| 213 | |||
| 214 | $nick = ( split /_/, $nick )[0] || $nick; | ||
| 215 | $nick = ( split /\|/, $nick )[0] || $nick; | ||
| 216 | |||
| 217 | my $sth = $dbh->prepare( "SELECT nick FROM aliases WHERE alias = '$nick'" ); | ||
| 218 | $sth->execute(); | ||
| 219 | if( my @row = $sth->fetchrow_array ) { | ||
| 220 | $nick = $row[0]; | ||
| 221 | } | ||
| 222 | |||
| 223 | return $nick; | ||
| 224 | } | ||
| 225 | |||
| 183 | sub francoise_verifyuser { | 226 | sub francoise_verifyuser { |
| 184 | my $nick_ = $_[0]; | 227 | my $nick_ = $_[0]; |
| 185 | my $host = $_[1]; | 228 | my $host = $_[1]; |
| 186 | my $updtime = $_[2]; | 229 | my $updtime = $_[2]; |
| 187 | my $kernel = $_[3]; | 230 | my $kernel = $_[3]; |
| 188 | 231 | ||
| 189 | my $nick = ( split /_/, $nick_ )[0] || $nick_; | 232 | my $nick = francoise_getbasenick( $nick_ ); |
| 190 | 233 | ||
| 191 | if( $host ) { | 234 | if( $host ) { |
| 192 | my ($cnt) = $dbh->selectrow_array( "SELECT COUNT(*) FROM users WHERE nick='$nick'" ); | 235 | my ($cnt) = $dbh->selectrow_array( "SELECT COUNT(*) FROM users WHERE nick='$nick'" ); |
