diff options
Diffstat (limited to 'bot.pl')
-rw-r--r-- | bot.pl | 116 |
1 files changed, 48 insertions, 68 deletions
@@ -3,7 +3,6 @@ | |||
3 | use strict; | 3 | use strict; |
4 | use DBI; | 4 | use DBI; |
5 | 5 | ||
6 | |||
7 | # IRC Server stuff | 6 | # IRC Server stuff |
8 | use POE; | 7 | use POE; |
9 | use POE::Component::IRC; | 8 | use POE::Component::IRC; |
@@ -11,8 +10,7 @@ use POE::Component::IRC; | |||
11 | my $current_nick = "francoise"; | 10 | my $current_nick = "francoise"; |
12 | my $channel = '#test'; | 11 | my $channel = '#test'; |
13 | 12 | ||
14 | POE::Component::IRC->new("irc_client"); | 13 | POE::Component::IRC->new("francoise"); |
15 | |||
16 | POE::Session->new ( _start => \&irc_start, | 14 | POE::Session->new ( _start => \&irc_start, |
17 | irc_join => \&irc_join, | 15 | irc_join => \&irc_join, |
18 | irc_part => \&irc_part, | 16 | irc_part => \&irc_part, |
@@ -25,12 +23,12 @@ POE::Session->new ( _start => \&irc_start, | |||
25 | irc_public => \&irc_pub_msg, | 23 | irc_public => \&irc_pub_msg, |
26 | irc_msg => \&irc_priv_msg, | 24 | irc_msg => \&irc_priv_msg, |
27 | irc_ctcp_action => \&irc_action, | 25 | irc_ctcp_action => \&irc_action, |
28 | _default => \&_default, | 26 | # _default => \&_default, |
29 | ); | 27 | ); |
30 | 28 | ||
31 | sub _default { | 29 | sub _default { |
32 | if ( $_[ARG0] =~ /^irc_(.*)$/ ) { | 30 | if ( $_[ARG0] =~ /^irc_(.*)$/ ) { |
33 | # print "IRC $1 received\n"; | 31 | print "IRC $1 received\n"; |
34 | } | 32 | } |
35 | } | 33 | } |
36 | 34 | ||
@@ -54,60 +52,53 @@ my $dbh = DBI->connect("DBI:Pg:dbname='francoise'", 'francoise', 'kiffer') | |||
54 | or die "ohoh, datenbank b0rken: $!"; | 52 | or die "ohoh, datenbank b0rken: $!"; |
55 | 53 | ||
56 | sub irc_start { | 54 | sub irc_start { |
57 | # KERNEL, HEAP, and SESSION are constants exported by POE | 55 | my ( $kernel, $heap, $session ) = @_[KERNEL, HEAP, SESSION ]; |
58 | my $kernel = $_[KERNEL]; | ||
59 | my $heap = $_[HEAP]; | ||
60 | my $session = $_[SESSION]; | ||
61 | 56 | ||
62 | $kernel->refcount_increment( $session->ID(), "my bot"); | 57 | $kernel->refcount_increment( $session->ID(), "my bot"); |
63 | $kernel->post(irc_client=> register=> "all"); | 58 | $kernel->post(francoise=> register=> "all"); |
64 | 59 | ||
65 | $kernel->post(irc_client=>connect=> { Nick => $current_nick, | 60 | $kernel->post(francoise=>connect=> { Nick => $current_nick, |
66 | Username => 'francoise', | 61 | Username => 'francoise', |
67 | Ircname => 'francoise', | 62 | Ircname => 'francoise', |
68 | Server => 'irc.kiffer.de', | 63 | Server => 'irc.kiffer.de', |
69 | Port => '6667', | 64 | Port => '6667', |
70 | } | 65 | } |
71 | ); | 66 | ); |
72 | } | 67 | } |
73 | 68 | ||
74 | sub irc_connect { | 69 | sub irc_connect { |
75 | my $kernel = $_[KERNEL]; | 70 | my $kernel = $_[KERNEL]; |
76 | 71 | $kernel->post(francoise=>join=>$channel); | |
77 | $kernel->post(irc_client=>join=>$channel); | ||
78 | } | 72 | } |
79 | 73 | ||
80 | sub irc_motd { | 74 | sub irc_motd { |
81 | my $msg = $_[ARG1]; | 75 | my $msg = $_[ARG1]; |
82 | |||
83 | print "MOTD: $msg\n"; | 76 | print "MOTD: $msg\n"; |
84 | } | 77 | } |
85 | 78 | ||
86 | sub irc_names { | 79 | sub irc_names { |
87 | my $kernel = $_[KERNEL]; | 80 | my $kernel = $_[KERNEL]; |
88 | my $names = (split /:/, $_[ARG1])[1]; | 81 | my ( $channel, $names ) = (split /:/, $_[ARG1]); |
89 | my $channel = (split /:/, $_[ARG1])[0]; | ||
90 | 82 | ||
91 | $channel =~ s/[@|=] (.*?) /$1/; | 83 | $channel =~ s/[@|=] (.*?) /$1/; |
92 | |||
93 | print "#-> Users on $channel [ $names ]\n"; | 84 | print "#-> Users on $channel [ $names ]\n"; |
94 | 85 | ||
95 | for my $user (split / /, $names) { | 86 | for my $user (split / /, $names) { |
96 | $user =~ s/^[@%+]//; | 87 | $user =~ s/^[@%+]//; |
97 | $kernel->post( 'irc_client', 'whois', $user); | 88 | $kernel->post( 'francoise', 'whois', $user); |
98 | } | 89 | } |
99 | } | 90 | } |
100 | 91 | ||
101 | #nick change | 92 | #nick change |
102 | sub irc_nick { | 93 | sub irc_nick { |
94 | my ( $kernel, $newnick_ ) = @_[ KERNEL, ARG1 ]; | ||
103 | my $oldnick_ = (split /!/, $_[ARG0])[0]; | 95 | my $oldnick_ = (split /!/, $_[ARG0])[0]; |
104 | my $newnick_ = $_[ARG1]; | ||
105 | 96 | ||
106 | my $oldnick = francoise_getbasenick( $oldnick_ ); | 97 | my $oldnick = francoise_getbasenick( $oldnick_ ); |
107 | my $newnick = francoise_getbasenick( $newnick_ ); | 98 | my $newnick = francoise_getbasenick( $newnick_ ); |
108 | 99 | ||
109 | if( $newnick_ ne $current_nick && $newnick ne $oldnick ) { | 100 | if( $newnick_ ne $current_nick && $newnick ne $oldnick ) { |
110 | francoise_verifyuser( $newnick_, '', 0 ); | 101 | francoise_verifyuser( $newnick_, '', 0, $kernel ); |
111 | } | 102 | } |
112 | 103 | ||
113 | print "#-> $oldnick_ is now known as $newnick_\n"; | 104 | print "#-> $oldnick_ is now known as $newnick_\n"; |
@@ -117,19 +108,17 @@ sub irc_nick { | |||
117 | sub irc_part { | 108 | sub irc_part { |
118 | my $nick = (split /!/, $_[ARG0])[0]; | 109 | my $nick = (split /!/, $_[ARG0])[0]; |
119 | my $channel = $_[ARG1]; | 110 | my $channel = $_[ARG1]; |
120 | |||
121 | print "#-> $nick has parted $channel\n"; | 111 | print "#-> $nick has parted $channel\n"; |
122 | } | 112 | } |
123 | 113 | ||
124 | #user joined | 114 | #user joined |
125 | sub irc_join { | 115 | sub irc_join { |
126 | my $kernel = $_[KERNEL]; | 116 | my ( $kernel, $channel ) = @_[KERNEL, ARG1]; |
127 | my $nick = (split /!/, $_[ARG0])[0]; | 117 | my $nick = (split /!/, $_[ARG0])[0]; |
128 | my $channel = $_[ARG1]; | ||
129 | my $host = (split /@/, $_[ARG0])[1]; | 118 | my $host = (split /@/, $_[ARG0])[1]; |
130 | 119 | ||
131 | if( $nick eq $current_nick ) { | 120 | if( $nick eq $current_nick ) { |
132 | $kernel->post( 'irc_client', 'privmsg', $channel, 'Hier bin ich!'); | 121 | $kernel->post( 'francoise', 'privmsg', $channel, 'Hier bin ich!'); |
133 | } else { | 122 | } else { |
134 | francoise_verifyuser( $nick, $host, 1 ); | 123 | francoise_verifyuser( $nick, $host, 1 ); |
135 | } | 124 | } |
@@ -141,15 +130,13 @@ sub irc_join { | |||
141 | sub irc_quit { | 130 | sub irc_quit { |
142 | my $nick = $_[ARG0]; | 131 | my $nick = $_[ARG0]; |
143 | my $reason = $_[ARG1]; | 132 | my $reason = $_[ARG1]; |
144 | |||
145 | print "#-> $nick has quit ($reason)\n"; | 133 | print "#-> $nick has quit ($reason)\n"; |
146 | } | 134 | } |
147 | 135 | ||
148 | sub irc_pub_msg{ | 136 | sub irc_pub_msg{ |
149 | my $kernel = $_[KERNEL]; | 137 | my ( $kernel, $msg ) = @_[KERNEL, ARG2]; |
150 | my $nick_ = (split /!/, $_[ARG0])[0]; | ||
151 | my $channel = $_[ARG1]->[0]; | 138 | my $channel = $_[ARG1]->[0]; |
152 | my $msg = $_[ARG2]; | 139 | my $nick_ = (split /!/, $_[ARG0])[0]; |
153 | my @words = (split / /, $msg); | 140 | my @words = (split / /, $msg); |
154 | my $numwords = $#words; | 141 | my $numwords = $#words; |
155 | 142 | ||
@@ -162,12 +149,12 @@ sub irc_pub_msg{ | |||
162 | if( $msg =~ /^wo ist (\S+)\??$/i ) { | 149 | if( $msg =~ /^wo ist (\S+)\??$/i ) { |
163 | my $wois_ = $1; | 150 | my $wois_ = $1; |
164 | my $wois = francoise_getbasenick( $1 ); | 151 | my $wois = francoise_getbasenick( $1 ); |
165 | my $sth = $dbh->prepare( "SELECT awaymsg FROM users WHERE nick = '$wois' AND isaway = 'true'"); | 152 | my $sth = $dbh->prepare( "SELECT awaymsg FROM users WHERE nick = ? AND isaway = 'true'"); |
166 | $sth->execute(); | 153 | $sth->execute( $wois ); |
167 | if ( my @awaymsg = $sth->fetchrow_array ) { | 154 | if ( my @awaymsg = $sth->fetchrow_array ) { |
168 | $kernel->post( 'irc_client', 'privmsg', $channel, "$wois_ ist $awaymsg[0]" ); | 155 | $kernel->post( 'francoise', 'privmsg', $channel, "$wois_ ist $awaymsg[0]" ); |
169 | } else { | 156 | } else { |
170 | $kernel->post( 'irc_client', 'privmsg', $channel, "Ich weiss nicht, wo $wois_ ist." ); | 157 | $kernel->post( 'francoise', 'privmsg', $channel, "Ich weiss nicht, wo $wois_ ist." ); |
171 | } | 158 | } |
172 | } elsif( $msg =~ /(.+?) ($hv) (.*)$/i ) { | 159 | } elsif( $msg =~ /(.+?) ($hv) (.*)$/i ) { |
173 | my $trigger = $1; | 160 | my $trigger = $1; |
@@ -181,15 +168,16 @@ sub irc_pub_msg{ | |||
181 | $sth->execute( $msg ); | 168 | $sth->execute( $msg ); |
182 | if( my ($trigger, $hilfsverb, $reply) = $sth->fetchrow_array ) { | 169 | if( my ($trigger, $hilfsverb, $reply) = $sth->fetchrow_array ) { |
183 | if( $reply =~ /^<reply>(.*)$/ ) { | 170 | if( $reply =~ /^<reply>(.*)$/ ) { |
184 | $kernel->post( 'irc_client', 'privmsg', $channel, "$1"); | 171 | $kernel->post( 'francoise', 'privmsg', $channel, "$1"); |
185 | } else { | 172 | } else { |
186 | $kernel->post( 'irc_client', 'privmsg', $channel, "$trigger $hilfsverb $reply"); | 173 | $kernel->post( 'francoise', 'privmsg', $channel, "$trigger $hilfsverb $reply"); |
187 | } | 174 | } |
188 | } | 175 | } |
189 | } | 176 | } |
190 | 177 | ||
191 | if( $nick ne $current_nick ) { | 178 | if( $nick ne $current_nick ) { |
192 | $dbh->do( "UPDATE users SET lines = lines + 1, words = words + $numwords + 1, isaway = false WHERE nick = '$nick'" ); | 179 | my $sth = $dbh->do( "UPDATE users SET lines = lines + 1, words = words + $numwords + 1, isaway = false WHERE nick = ?" ); |
180 | $sth->execute( $nick ); | ||
193 | } | 181 | } |
194 | 182 | ||
195 | print "$channel: <$nick> $msg\n"; | 183 | print "$channel: <$nick> $msg\n"; |
@@ -203,8 +191,8 @@ sub irc_action{ | |||
203 | 191 | ||
204 | if( $msg =~ /^ist (.+)$/ ) { | 192 | if( $msg =~ /^ist (.+)$/ ) { |
205 | my $awaymsg = $1; | 193 | my $awaymsg = $1; |
206 | my $sth = $dbh->prepare( "UPDATE users SET isaway = true, awaymsg = ? WHERE nick = '$nick'"); | 194 | my $sth = $dbh->prepare( "UPDATE users SET isaway = true, awaymsg = ? WHERE nick = ?"); |
207 | $sth->execute( $awaymsg ); | 195 | $sth->execute( $awaymsg, $nick ); |
208 | } | 196 | } |
209 | } | 197 | } |
210 | 198 | ||
@@ -217,14 +205,13 @@ sub irc_priv_msg{ | |||
217 | } | 205 | } |
218 | 206 | ||
219 | if( $msg =~ /^!say (.*)$/ ) { | 207 | if( $msg =~ /^!say (.*)$/ ) { |
220 | $kernel->post( 'irc_client', 'privmsg', $channel, $1); } | 208 | $kernel->post( 'francoise', 'privmsg', $channel, $1); } |
221 | 209 | ||
222 | print "PRIV: [$nick] $msg\n"; | 210 | print "PRIV: [$nick] $msg\n"; |
223 | } | 211 | } |
224 | 212 | ||
225 | sub irc_whois{ | 213 | sub irc_whois{ |
226 | my $nick = (split / /, $_[ARG1])[0]; | 214 | my ( $nick, $host ) = (split / /, $_[ARG1])[0,2]; |
227 | my $host = (split / /, $_[ARG1])[2]; | ||
228 | 215 | ||
229 | if( $nick ne $current_nick ) { | 216 | if( $nick ne $current_nick ) { |
230 | francoise_verifyuser( $nick, $host, 0 ); | 217 | francoise_verifyuser( $nick, $host, 0 ); |
@@ -234,12 +221,11 @@ sub irc_whois{ | |||
234 | sub francoise_getbasenick{ | 221 | sub francoise_getbasenick{ |
235 | my $nick = $_[0]; | 222 | my $nick = $_[0]; |
236 | 223 | ||
237 | |||
238 | $nick = ( split /_/, $nick )[0] || $nick; | 224 | $nick = ( split /_/, $nick )[0] || $nick; |
239 | $nick = ( split /\|/, $nick )[0] || $nick; | 225 | $nick = ( split /\|/, $nick )[0] || $nick; |
240 | 226 | ||
241 | my $sth = $dbh->prepare( "SELECT nick FROM aliases WHERE alias = '$nick'" ); | 227 | my $sth = $dbh->prepare( "SELECT nick FROM aliases WHERE alias = ?" ); |
242 | $sth->execute(); | 228 | $sth->execute($nick); |
243 | if( my @row = $sth->fetchrow_array ) { | 229 | if( my @row = $sth->fetchrow_array ) { |
244 | $nick = $row[0]; | 230 | $nick = $row[0]; |
245 | } | 231 | } |
@@ -248,11 +234,7 @@ sub francoise_getbasenick{ | |||
248 | } | 234 | } |
249 | 235 | ||
250 | sub francoise_verifyuser { | 236 | sub francoise_verifyuser { |
251 | my $nick_ = $_[0]; | 237 | my ( $nick_, $host, $updtime, $kernel ) = @_; |
252 | my $host = $_[1]; | ||
253 | my $updtime = $_[2]; | ||
254 | my $kernel = $_[3]; | ||
255 | |||
256 | my $nick = francoise_getbasenick( $nick_ ); | 238 | my $nick = francoise_getbasenick( $nick_ ); |
257 | 239 | ||
258 | if( $host ) { | 240 | if( $host ) { |
@@ -263,23 +245,22 @@ sub francoise_verifyuser { | |||
263 | $dbh->do( "UPDATE users SET lasthost = '$host'" . ( $updtime ? ", lastlogin = now()" : "" ) . " WHERE nick = '$nick'" ); | 245 | $dbh->do( "UPDATE users SET lasthost = '$host'" . ( $updtime ? ", lastlogin = now()" : "" ) . " WHERE nick = '$nick'" ); |
264 | } | 246 | } |
265 | } else { | 247 | } else { |
266 | $kernel->post( 'irc_client', 'whois', $nick_); | 248 | $kernel->post( 'francoise', 'whois', $nick_); |
267 | } | 249 | } |
268 | 250 | ||
269 | return $nick; | 251 | return $nick; |
270 | } | 252 | } |
271 | 253 | ||
272 | sub francoise_help { | 254 | sub francoise_help { |
273 | my $kernel = $_[0]; | 255 | my ( $kernel, $dest ) = @_; |
274 | my $dest = $_[1]; | 256 | |
275 | 257 | $kernel->post( 'francoise', 'privmsg', $dest, 'Hallo, ich bin Francoise, der freundliche Kifferchat-Bot.'); | |
276 | $kernel->post( 'irc_client', 'privmsg', $dest, 'Hallo, ich bin Francoise, der freundliche Kifferchat-Bot.'); | 258 | $kernel->post( 'francoise', 'privmsg', $dest, 'Ich kann folgende Kommandos ausfuehren:'); |
277 | $kernel->post( 'irc_client', 'privmsg', $dest, 'Ich kann folgende Kommandos ausfuehren:'); | 259 | $kernel->post( 'francoise', 'privmsg', $dest, '!help Diese Hilfe anzeigen'); |
278 | $kernel->post( 'irc_client', 'privmsg', $dest, '!help Diese Hilfe anzeigen'); | 260 | $kernel->post( 'francoise', 'privmsg', $dest, '!stat Informationen ueber mich ausgeben'); |
279 | $kernel->post( 'irc_client', 'privmsg', $dest, '!stat Informationen ueber mich ausgeben'); | 261 | $kernel->post( 'francoise', 'privmsg', $dest, '!topten Die aktivsten Chatter anzeigen'); |
280 | $kernel->post( 'irc_client', 'privmsg', $dest, '!topten Die aktivsten Chatter anzeigen'); | 262 | $kernel->post( 'francoise', 'privmsg', $dest, '!topten0r Die 13370rsten Chatter anzeigen'); |
281 | $kernel->post( 'irc_client', 'privmsg', $dest, '!topten0r Die 13370rsten Chatter anzeigen'); | 263 | $kernel->post( 'francoise', 'privmsg', $dest, '!forget Einen Trigger vergessen'); |
282 | $kernel->post( 'irc_client', 'privmsg', $dest, '!forget Einen Trigger vergessen'); | ||
283 | } | 264 | } |
284 | 265 | ||
285 | sub francoise_stat { | 266 | sub francoise_stat { |
@@ -287,13 +268,12 @@ sub francoise_stat { | |||
287 | } | 268 | } |
288 | 269 | ||
289 | sub francoise_topten { | 270 | sub francoise_topten { |
290 | my $kernel = $_[0]; | 271 | my ($kernel, $dest ) = @_; |
291 | my $dest = $_[1]; | ||
292 | 272 | ||
293 | my $sth = $dbh->prepare( "SELECT words, nick FROM users ORDER BY words DESC LIMIT 10" ); | 273 | my $sth = $dbh->prepare( "SELECT words, nick FROM users ORDER BY words DESC LIMIT 10" ); |
294 | $sth->execute(); | 274 | $sth->execute(); |
295 | while ( my @row = $sth->fetchrow_array ) { | 275 | while ( my @row = $sth->fetchrow_array ) { |
296 | $kernel->post( 'irc_client', 'privmsg', $dest, "$row[0] $row[1]" ); | 276 | $kernel->post( 'francoise', 'privmsg', $dest, "$row[0] $row[1]" ); |
297 | } | 277 | } |
298 | } | 278 | } |
299 | 279 | ||