summaryrefslogtreecommitdiff
path: root/bot.pl
diff options
context:
space:
mode:
Diffstat (limited to 'bot.pl')
-rw-r--r--bot.pl116
1 files changed, 48 insertions, 68 deletions
diff --git a/bot.pl b/bot.pl
index b216b17..267c107 100644
--- a/bot.pl
+++ b/bot.pl
@@ -3,7 +3,6 @@
3use strict; 3use strict;
4use DBI; 4use DBI;
5 5
6
7# IRC Server stuff 6# IRC Server stuff
8use POE; 7use POE;
9use POE::Component::IRC; 8use POE::Component::IRC;
@@ -11,8 +10,7 @@ use POE::Component::IRC;
11my $current_nick = "francoise"; 10my $current_nick = "francoise";
12my $channel = '#test'; 11my $channel = '#test';
13 12
14POE::Component::IRC->new("irc_client"); 13POE::Component::IRC->new("francoise");
15
16POE::Session->new ( _start => \&irc_start, 14POE::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
31sub _default { 29sub _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
56sub irc_start { 54sub 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
74sub irc_connect { 69sub 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
80sub irc_motd { 74sub 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
86sub irc_names { 79sub 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
102sub irc_nick { 93sub 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 {
117sub irc_part { 108sub 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
125sub irc_join { 115sub 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 {
141sub irc_quit { 130sub 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
148sub irc_pub_msg{ 136sub 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
225sub irc_whois{ 213sub 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{
234sub francoise_getbasenick{ 221sub 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
250sub francoise_verifyuser { 236sub 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
272sub francoise_help { 254sub 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
285sub francoise_stat { 266sub francoise_stat {
@@ -287,13 +268,12 @@ sub francoise_stat {
287} 268}
288 269
289sub francoise_topten { 270sub 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