lib/Keitairc/IrcCallback.pm

   1 # -*- mode: perl; coding: utf-8 -*-
   2 # Keitairc::IrcCallback
   3 #
   4 # Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
   5 # This program is covered by the GNU General Public License 2
   6
   7 package Keitairc::IrcCallback;
   8 use POE;
   9 use Encode qw(decode);
  10 use strict;
  11 use warnings;
  12
  13 ################################################################
  14 sub irc_start{
  15         my $heap = $_[HEAP];
  16         $heap->{Irc}->yield(register => 'all');
  17 }
  18
  19 ################################################################
  20 sub irc_registered{
  21         my $heap = $_[HEAP];
  22         $heap->{Irc}->yield(connect => {});
  23 }
  24
  25 ################################################################
  26 sub irc_001{
  27         my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
  28         my $ib = $heap->{IrcBuffer};
  29         my $cf = $heap->{Config};
  30         my $msg = 'Connected to irc server!';
  31
  32         if ($cf->show_console()) {
  33                 $ib->add_message($ib->name2cid('*Console*'), $msg);
  34         } else {
  35                 for my $cid ($ib->channels()) {
  36                         $ib->add_message($cid, $msg);
  37                 }
  38         }
  39         $heap->{disconnect_msg} = 1;
  40         $kernel->delay(autoping => $cf->ping_delay());
  41 }
  42
  43 ################################################################
  44 sub irc_public{
  45         my ($kernel, $heap, $who, $channel, $msg) = @_[KERNEL, HEAP, ARG0 .. ARG2];
  46         my $ib = $heap->{IrcBuffer};
  47         my $cf = $heap->{Config};
  48         $who =~ s/!.*//;
  49         $msg = decode($cf->irc_charset(), $msg);
  50         my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel->[0]));
  51         $heap->{IrcBuffer}->add_message($cid, $msg, $who);
  52         $heap->{seen_traffic} = 1;
  53         $heap->{disconnect_msg} = 1;
  54 }
  55
  56 ################################################################
  57 sub irc_join{
  58         my ($kernel, $heap, $who, $channel) = @_[KERNEL, HEAP, ARG0, ARG1];
  59         my $ib = $heap->{IrcBuffer};
  60         my $cf = $heap->{Config};
  61
  62         $who =~ s/!.*//;
  63
  64         $channel = decode($cf->irc_charset(), $channel);
  65
  66         # chop off after the gap to workaround madoka's bug
  67         $channel =~ s/ .*//;
  68
  69         $ib->join($channel);
  70         if($who ne $cf->irc_nick() && $cf->show_joinleave()) {
  71                 my $cid = $ib->name2cid($channel);
  72                 if ($cf->show_console()) {
  73                         my $ch = $ib->compact_channel_name($cid);
  74                         $ib->add_message($ib->name2cid('*Console*'),
  75                                          "$who joined to $ch");
  76                 } else {
  77                         $ib->add_message($cid, "$who joined");
  78                 }
  79         }
  80
  81         if($cf->follow_nick()){
  82                 $heap->{Irc}->yield(who => $channel);
  83         }
  84         $heap->{seen_traffic} = 1;
  85         $heap->{disconnect_msg} = 1;
  86 }
  87
  88 ################################################################
  89 sub irc_part{
  90         my ($kernel, $heap, $who, $channel) = @_[KERNEL, HEAP, ARG0, ARG1];
  91         my $ib = $heap->{IrcBuffer};
  92         my $cf = $heap->{Config};
  93
  94         $who =~ s/!.*//;
  95
  96         $channel = decode($cf->irc_charset(), $channel);
  97         # chop off after the gap (bug workaround of POE::Filter::IRC)
  98         $channel =~ s/ .*//;
  99
 100         my $cid = $ib->name2cid($channel);
 101         if($who eq $cf->irc_nick()){
 102                 $ib->part($cid);
 103         } elsif ($cf->show_joinleave()) {
 104                 if ($cf->show_console()) {
 105                         my $ch = $ib->compact_channel_name($cid);
 106                         $ib->add_message($ib->name2cid('*Console*'),
 107                                          "$who leaves from $ch");
 108                 } else {
 109                         $ib->add_message($cid, "$who leaves");
 110                 }
 111         }
 112         $ib->remove_nick($cid, $who);
 113         $heap->{seen_traffic} = 1;
 114         $heap->{disconnect_msg} = 1;
 115 }
 116
 117 ################################################################
 118 sub irc_quit{
 119         my ($kernel, $heap, $who, $message) = @_[KERNEL, HEAP, ARG0, ARG1];
 120         my $ib = $heap->{IrcBuffer};
 121         my $cf = $heap->{Config};
 122
 123         $who =~ s/!.*//;
 124         $message = decode($cf->irc_charset(), $message);
 125
 126         for my $cid ($ib->channels()) {
 127                 for my $name ($ib->list_nick($cid)) {
 128                         if($who ne $name) {
 129                                 next;
 130                         }
 131                         if($who eq $cf->irc_nick()){
 132                                 $ib->part($cid);
 133                         } elsif (!$cf->show_console() &&
 134                                  $cf->show_joinleave()) {
 135                                 $ib->add_message($cid,
 136                                         "$who leaves from IRC ($message)");
 137                         }
 138                         $ib->remove_nick($cid, $who);
 139                         last;
 140                 }
 141         }
 142
 143         if ($cf->show_console() && $cf->show_joinleave()) {
 144                 $ib->add_message($ib->name2cid('*Console*'),
 145                         "$who leaves from IRC ($message)");
 146         }
 147
 148         $heap->{seen_traffic} = 1;
 149         $heap->{disconnect_msg} = 1;
 150 }
 151
 152 ################################################################
 153 sub irc_whoreply{
 154         my ($kernel, $heap, $arg) = @_[KERNEL, HEAP, ARG1];
 155         my ($channel, $user, $host, $server, $nick, $hg, $hop, @realname) =
 156                 split(/\s/, $arg);
 157         my $ib = $heap->{IrcBuffer};
 158         my $cf = $heap->{Config};
 159         my $op = ($hg =~ /@/ ? 1 : 0);
 160         my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel));
 161         # @realname may be irc channel's charset
 162         $ib->add_nick($cid, $nick, $op, decode($cf->irc_charset(), join(' ', @realname)));
 163 }
 164
 165 ################################################################
 166 sub irc_mode{
 167         my ($kernel, $heap, $from, $channel, $mode, @args) =
 168                 @_[KERNEL, HEAP, ARG0, ARG1, ARG2, ARG3 .. $#_];
 169
 170         my $ib = $heap->{IrcBuffer};
 171         my $cf = $heap->{Config};
 172         my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel));
 173         if($mode =~ s/^\+//){
 174                 while($mode =~ s/^o//){
 175                         my $nick = shift @args;
 176                         $ib->op_nick($cid, $nick);
 177                 }
 178         }elsif($mode =~ s/^-//){
 179                 while($mode =~ s/^o//){
 180                         my $nick = shift @args;
 181                         $ib->deop_nick($cid, $nick);
 182                 }
 183         }
 184 }
 185
 186 ################################################################
 187 sub irc_nick{
 188         my ($kernel, $heap, $who, $nick) = @_[KERNEL, HEAP, ARG0, ARG1];
 189         my $ib = $heap->{IrcBuffer};
 190         my $cf = $heap->{Config};
 191
 192         $who =~ s/!.*//;
 193
 194         if($who eq $cf->irc_nick()) {
 195                 $cf->irc_nick($nick);
 196         }
 197
 198         for my $cid ($ib->channels()) {
 199                 for my $name ($ib->list_nick($cid)) {
 200                         if($who ne $name) {
 201                                 next;
 202                         }
 203                         my $realname = $ib->get_nick_realname($cid, $who);
 204                         my $op = $ib->get_nick_op($cid, $who);
 205                         $ib->remove_nick($cid, $who);
 206                         $ib->add_nick($cid, $nick, $op, $realname);
 207
 208                         if (!$cf->show_console() && $cf->show_joinleave()) {
 209                                 $ib->add_message($cid, "$who -> $nick");
 210                         }
 211                         last;
 212                 }
 213
 214         }
 215
 216         if ($cf->show_console() && $cf->show_joinleave()) {
 217                 $ib->add_message($ib->name2cid('*Console*'), "$who -> $nick");
 218         }
 219 }
 220
 221 ################################################################
 222 sub irc_notice{
 223         my ($kernel, $heap, $who, $channel, $msg) = @_[KERNEL, HEAP, ARG0 .. ARG2];
 224         my $ib = $heap->{IrcBuffer};
 225         my $cf = $heap->{Config};
 226
 227         $who =~ s/!.*//;
 228         my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel->[0]));
 229         $msg = decode($cf->irc_charset(), $msg);
 230
 231         $ib->add_message($cid, $msg, $who);
 232         $heap->{seen_traffic} = 1;
 233         $heap->{disconnect_msg} = 1;
 234 }
 235
 236 ################################################################
 237 sub irc_topic{
 238         my ($kernel, $heap, $who, $channel, $topic) = @_[KERNEL, HEAP, ARG0 .. ARG2];
 239         my $ib = $heap->{IrcBuffer};
 240         my $cf = $heap->{Config};
 241         my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel));
 242         $topic = decode($cf->irc_charset(), $topic);
 243         $ib->topic($cid, $topic);
 244         $who =~ s/!.*//;
 245         $ib->add_message($cid, "$who set topic: $topic");
 246         $heap->{seen_traffic} = 1;
 247         $heap->{disconnect_msg} = 1;
 248 }
 249
 250 ################################################################
 251 sub irc_topicraw{
 252         my ($kernel, $heap, $raw) = @_[KERNEL, HEAP, ARG1];
 253         my ($channel, $topic) = ($raw =~ m/(\S+)\s+:?(.*)$/);
 254         my $ib = $heap->{IrcBuffer};
 255         my $cf = $heap->{Config};
 256         my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel));
 257         $ib->topic($cid, decode($cf->irc_charset(), $topic));
 258         $heap->{seen_traffic} = 1;
 259         $heap->{disconnect_msg} = 1;
 260 }
 261
 262 ################################################################
 263 sub irc_msg{
 264         my ($kernel, $heap, $who, $channel, $msg) = @_[KERNEL, HEAP, ARG0 .. ARG2];
 265         my $ib = $heap->{IrcBuffer};
 266         my $cf = $heap->{Config};
 267         my $buddy;
 268
 269         $who =~ s/!.*//;
 270
 271         if ($who eq $cf->irc_nick()) {
 272                 # XXX: $channel may contain two or more nicks.
 273                 $buddy = $channel->[0];
 274         } else {
 275                 $buddy = $who;
 276         }
 277         $buddy = decode($cf->irc_charset(), $buddy);
 278         $ib->join($buddy); # XXX: join $buddy if not joined
 279         my $cid = $ib->name2cid($buddy);
 280         $msg = decode($cf->irc_charset(), $msg);
 281         $ib->add_message($cid, $msg, $who);
 282         $heap->{seen_traffic} = 1;
 283         $heap->{disconnect_msg} = 1;
 284 }
 285
 286 ################################################################
 287 sub irc_ctcp_action{
 288         my ($kernel, $heap, $who, $channel, $msg) = @_[KERNEL, HEAP, ARG0 .. ARG2];
 289         my $ib = $heap->{IrcBuffer};
 290         my $cf = $heap->{Config};
 291
 292         $who =~ s/!.*//;
 293         my $cid = $ib->name2cid(decode($cf->irc_charset(), $channel->[0]));
 294         $msg = decode($cf->irc_charset(), $msg);
 295         $ib->add_message($cid, sprintf('* %s %s', $who, $msg));
 296         $heap->{seen_traffic} = 1;
 297         $heap->{disconnect_msg} = 1;
 298 }
 299
 300 ################################################################
 301 sub irc_reconnect{
 302         my ($kernel, $heap) = @_[KERNEL, HEAP];
 303         my $ib = $heap->{IrcBuffer};
 304         my $cf = $heap->{Config};
 305         my $msg = 'Disconnected from irc server, trying to reconnect...';
 306
 307         if ($heap->{disconnect_msg}) {
 308                 if ($cf->show_console()) {
 309                         $ib->add_message($ib->name2cid('*Console*'), $msg);
 310                 } else {
 311                         for my $cid ($ib->channels()) {
 312                                 $ib->add_message($cid, $msg);
 313                         }
 314                 }
 315         }
 316         $heap->{disconnect_msg} = 0;
 317         $kernel->delay(connect => $cf->reconnect_delay());
 318 }
 319
 320 ################################################################
 321 sub irc_connect{
 322         my ($kernel, $heap) = @_[KERNEL, HEAP];
 323         $kernel->post(keitairc_irc => connect => {});
 324 }
 325
 326 ################################################################
 327 sub irc_autoping{
 328         my ($kernel, $heap) = @_[KERNEL, HEAP];
 329         my $cf = $heap->{Config};
 330
 331         $kernel->post(keitairc_irc => time) unless $heap->{seen_traffic};
 332         $heap->{seen_traffic} = 0;
 333         $kernel->delay(autoping => $cf->ping_delay());
 334 }
 335
 336 1;