diff -urN tiarra-20030925/ChangeLog tiarra-20030926/ChangeLog --- tiarra-20030925/ChangeLog 2003-09-26 12:50:56.000000000 +0900 +++ tiarra-20030926/ChangeLog 2003-09-26 21:14:49.000000000 +0900 @@ -1,3 +1,27 @@ +2003-09-26 Topia + + * tiarra: + --debug 時に warn と die に長いスタックトレースを表示する。 + + * main/ChannelInfo.pm: + topic_who と topic_time を追加。 + エラーメッセージのミスを修正。 + + * main/Multicast.pm: + RPL_TOPICWHOTIME の追加。 + hijack_local_to_global 時のフォールバック条件を訂正。 + + * main/IrcIO/Client.pm: + 431 No nickname given の実装。 + multi-server-mode でないときには nick 関連の特殊処理をしないように。 + RPL_TOPICWHOTIME の実装。 + + * main/IrcIO/Server.pm: + 437 nick/channel is temporarily unavailable に対応。 + multi-server-mode でないときには nick 関連の特殊処理をしないように。 + RPL_TOPICWHOTIME の実装。 + 9文字以上のnickが来たときに、可能な限り必要以上短くしないように。 + 2003-09-25 Topia * tiarra: @@ -904,7 +928,7 @@ * これ以前のログは書いていません。 -# Id: $Id: ChangeLog,v 1.103 2003/09/25 13:15:59 topia Exp $ +# Id: $Id: ChangeLog,v 1.104 2003/09/26 12:07:12 topia Exp $ # Author: $Author: topia $ -# Date: $Date: 2003/09/25 13:15:59 $ -# Revision: $Revision: 1.103 $ +# Date: $Date: 2003/09/26 12:07:12 $ +# Revision: $Revision: 1.104 $ diff -urN tiarra-20030925/main/ChannelInfo.pm tiarra-20030926/main/ChannelInfo.pm --- tiarra-20030925/main/ChannelInfo.pm 2003-09-26 12:50:57.000000000 +0900 +++ tiarra-20030926/main/ChannelInfo.pm 2003-09-26 21:14:49.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: ChannelInfo.pm,v 1.12 2003/09/20 11:06:20 admin Exp $ +# $Id: ChannelInfo.pm,v 1.13 2003/09/26 12:07:13 topia Exp $ # ----------------------------------------------------------------------------- # チャンネル情報を保持 # ----------------------------------------------------------------------------- @@ -13,11 +13,13 @@ sub new { # nameに鯖名まで付けないように注意。#channel@ircnetはNG。 - my ($class,$name,$network_name) = @_; + my ($class,$name,$network_name) = @_; my $obj = { name => $name, network_name => $network_name, topic => '', + topic_who => undef, + topic_time => undef, names => undef, # hash; nick => PersonInChannel switches => undef, # hash; aやsなどのチャンネルモード。キーがaやsで、値は常に1。 parameters => undef, # hash; lやkなどのチャンネルモード。 @@ -49,6 +51,8 @@ my $types = { topic => 'scalar', + topic_who => 'scalar', + topic_time => 'scalar', names => 'hash', switches => 'hash', parameters => 'hash', @@ -122,7 +126,7 @@ return $hash ? values %$hash : (); } else { - croak '[array]->([key],[value],'.$args[2].") is invalid\n"; + croak '[hash]->([key],[value],'.$args[2].") is invalid\n"; } } return ($hash and $args[0]) ? $hash->{$args[0]} : undef; diff -urN tiarra-20030925/main/IrcIO/Client.pm tiarra-20030926/main/IrcIO/Client.pm --- tiarra-20030925/main/IrcIO/Client.pm 2003-09-26 12:50:56.000000000 +0900 +++ tiarra-20030926/main/IrcIO/Client.pm 2003-09-26 21:14:49.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Client.pm,v 1.20 2003/09/20 11:06:18 admin Exp $ +# $Id: Client.pm,v 1.21 2003/09/26 12:07:13 topia Exp $ # ----------------------------------------------------------------------------- # IrcIO::Clientはクライアントからの接続を受け、 # IRCメッセージをやり取りするクラスです。 @@ -87,7 +87,7 @@ my $line = qr{^\$(?:\s*($pair)\s*)*\s*($lastpair)\s*\$$}; if (my @pairs = ($realname =~ m/$line/g)) { - %{$this->{options}} = map { + %{$this->{options}} = map { m/^\s*($key)\s*=\s*($value)\s*;?$/; } grep { defined; @@ -132,12 +132,12 @@ sub pop_queue { my $this = shift; my $msg = $this->SUPER::pop_queue; - + # クライアントがログイン中なら、ログインを受け付ける。 if (defined $msg) { # 各モジュールに通知 RunLoop->shared->notify_modules('notification_of_message_io',$msg,$this,'in'); - + # ログイン作業中か？ if ($this->{logging_in}) { return $this->_receive_while_logging_in($msg); @@ -151,7 +151,7 @@ sub _receive_while_logging_in { my ($this,$msg) = @_; - + # NICK及びUSERを受け取った時点でそのログインの正当性を確認し、作業を終了する。 my $command = $msg->command; if ($command eq 'PASS') { @@ -177,7 +177,7 @@ Param => 'Closing Link: ['.$this->fullname_from_client.'] ()')); $this->disconnect_after_writing; } - + if ($this->{nick} ne '' && $this->{username} ne '') { # general/tiarra-passwordを取得 my $valid_password = Configuration->shared_conf->general->tiarra_password; @@ -185,7 +185,7 @@ ! Crypt::check($this->{pass_received},$valid_password)) { # パスワードが正しくない。 ::printmsg("Refused login of ".$this->fullname_from_client." because of bad password."); - + $this->send_message( new IRCMessage(Prefix => 'tiarra', Command => '464', @@ -230,20 +230,20 @@ new IRCMessage(Prefix => 'tiarra', Command => 'NOTICE', Params => [$current_nick, - "*** Your global nick in $network_name is currently '$global_nick'."])); + "*** Your global nick in $network_name is currently '$global_nick'."])); } } values %{RunLoop->shared_loop->networks}; - + foreach my $line (main::get_credit()) { $this->send_message( new IRCMessage(Prefix => 'tiarra', Command => '002', Params => [$current_nick,$line])); } - + # joinしている全てのチャンネルの情報をクライアント送る。 $this->inform_joinning_channels; - + # 各モジュールにクライアント追加の通知を出す。 RunLoop->shared->notify_modules('client_attached',$this); } @@ -254,38 +254,50 @@ sub _receive_after_logged_in { my ($this,$msg) = @_; - + # ログイン中でない。 my $command = $msg->command; - + if ($command eq 'NICK') { - # 形式が正しい限りNICKには常に成功して、RunLoopのカレントnickが変更になる。 - # ただしネットワーク名が明示されていた場合はカレントを変更しない。 - my ($nick,undef,$specified) = Multicast::detatch($msg->params->[0]); - if (Multicast::nick_p($nick)) { - unless ($specified) { - #$this->send_message( - # new IRCMessage( - # Prefix => $this->fullname, - # Command => 'NICK', - # Param => $msg->params->[0])); - RunLoop->shared->broadcast_to_clients( - IRCMessage->new( - Command => 'NICK', - Param => $msg->param(0), - Remarks => {'fill-prefix-when-sending-to-client' => 1})); + if (defined $msg->params) { + # 形式が正しい限りNICKには常に成功して、RunLoopのカレントnickが変更になる。 + # ただしネットワーク名が明示されていた場合はカレントを変更しない。 + my ($nick,undef,$specified) = Multicast::detatch($msg->params->[0]); + if (Multicast::nick_p($nick)) { + unless ($specified) { + #$this->send_message( + # new IRCMessage( + # Prefix => $this->fullname, + # Command => 'NICK', + # Param => $msg->params->[0])); + if (RunLoop->shared->multi_server_mode_p) { + RunLoop->shared->broadcast_to_clients( + IRCMessage->new( + Command => 'NICK', + Param => $msg->param(0), + Remarks => {'fill-prefix-when-sending-to-client' => 1})); - RunLoop->shared_loop->set_current_nick($msg->params->[0]); + RunLoop->shared_loop->set_current_nick($msg->params->[0]); + } + } + } else { + $this->send_message( + new IRCMessage( + Prefix => 'tiarra', + Command => '432', + Params => [RunLoop->shared_loop->current_nick, + $msg->params->[0], + 'Erroneous nickname'])); + # これは鯖に送らない。 + $msg = undef; } - } - else { + } else { $this->send_message( new IRCMessage( Prefix => 'tiarra', - Command => '432', + Command => '431', Params => [RunLoop->shared_loop->current_nick, - $msg->params->[0], - 'Erroneous nickname'])); + 'No nickname given'])); # これは鯖に送らない。 $msg = undef; } @@ -293,15 +305,15 @@ elsif ($command eq 'QUIT') { my $quit_message = $msg->param(0); $quit_message = '' unless defined $quit_message; - + $this->send_message( new IRCMessage(Command => 'ERROR', Param => 'Closing Link: '.$this->fullname('error').' ('.$quit_message.')')); $this->disconnect_after_writing; - + # 接続が切れた事にする。 RunLoop->shared->notify_modules('client_detached',$this); - + # これは鯖に送らない。 $msg = undef; } @@ -322,7 +334,7 @@ my $global_to_local = sub { $_[0] eq $global_nick ? $local_nick : $_[0]; }; - + map { my $ch = $_; my $ch_name = do { @@ -333,7 +345,7 @@ $ch->name; } }; - + # まずJOIN $this->send_message( IRCMessage->new( @@ -348,6 +360,14 @@ Command => '332', Params => [$local_nick,$ch_name,$ch->topic])); } + # 次にRPL_TOPICWHOTIME(あれば) + if (defined($ch->topic_who)) { + $this->send_message( + IRCMessage->new( + Prefix => $this->fullname, + Command => '333', + Params => [$local_nick,$ch_name,$ch->topic_who,$ch->topic_time])); + } # 次にRPL_NAMREPLY my $ch_property_char = do { if ($ch->switches('s')) { @@ -365,7 +385,7 @@ my $flush_enum_buffer = sub { if ($nick_enumeration ne '') { $this->send_message( - IRCMessage->new( + IRCMessage->new( Prefix => $this->fullname, Command => '353', Params => [$local_nick, diff -urN tiarra-20030925/main/IrcIO/Server.pm tiarra-20030926/main/IrcIO/Server.pm --- tiarra-20030925/main/IrcIO/Server.pm 2003-09-26 12:50:57.000000000 +0900 +++ tiarra-20030926/main/IrcIO/Server.pm 2003-09-26 21:14:49.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Server.pm,v 1.45 2003/09/20 11:06:18 admin Exp $ +# $Id: Server.pm,v 1.46 2003/09/26 12:07:13 topia Exp $ # ----------------------------------------------------------------------------- # IrcIO::ServerはIRCサーバーに接続し、IRCメッセージをやり取りするクラスです。 # このクラスはサーバーからメッセージを受け取ってチャンネル情報や現在のnickなどを保持しますが、 @@ -16,6 +16,7 @@ use PersonInChannel; use Configuration; use UNIVERSAL; +use Multicast; sub new { my ($class,$network_name) = @_; @@ -26,7 +27,7 @@ $obj->{logged_in} = 0; # このサーバーへのログインに成功しているかどうか。 $obj->{new_connection} = 1; - + $obj->{receiving_namreply} = {}; # RPL_NAMREPLYを受け取ると<チャンネル名,1>になり、RPL_ENDOFNAMESを受け取るとそのチャンネルの要素が消える。 $obj->{receiving_banlist} = {}; # 同上。RPL_BANLIST $obj->{receiving_exceptlist} = {}; # 同上。RPL_EXCEPTLIST @@ -34,7 +35,7 @@ $obj->{channels} = {}; # チャンネル名 => ChannelInfo $obj->{people} = {}; # nick => PersonalInfo - + $obj->connect; } @@ -122,7 +123,7 @@ # 未知のnickが指定された場合は新規に追加する。 my ($this,$nick,$username,$userhost,$realname,$server) = @_; return if !defined $nick; - + my $info = $this->{people}->{$nick}; if (!defined($info)) { $info = $this->{people}->{$nick} = @@ -136,7 +137,7 @@ $info->username($username); $info->userhost($userhost); $info->realname($realname); - $info->server($server); + $info->server($server); } $info; } @@ -175,7 +176,7 @@ if (defined $ipv6_bind_addr) { $additional_ipv6->{LocalAddr} = $ipv6_bind_addr; } - + # ソケットを開く。開けなかったらdie。 # 接続は次のようにして行なう。 # 1. ホストがIPv4アドレスであれば、IPv4として接続を試みる。 @@ -237,7 +238,7 @@ else { die "Couldn't connect to $this->{destination}\n"; } - + # (PASS) -> NICK -> USERの順に送信し、中に入る。 # NICKが成功したかどうかは接続後のreceiveメソッドが判断する。 my $server_password = $this->{server_password}; @@ -278,7 +279,7 @@ sub disconnect { my $this = shift; - + $this->SUPER::disconnect; ::printmsg("Disconnected from $this->{destination}."); } @@ -298,7 +299,7 @@ # 各モジュールへ通知 RunLoop->shared->notify_modules('notification_of_message_io',$msg,$this,'out'); - + $this->SUPER::send_message( $msg, Configuration->shared->get($this->{network_name})->out_encoding || @@ -321,14 +322,14 @@ sub pop_queue { my ($this) = shift; my $msg = $this->SUPER::pop_queue; - + # このメソッドはログインしていなければログインするが、 # パスワードが違うなどで何度やり直してもログイン出来る見込みが無ければ # 接続を切ってからdieします。 if (defined $msg) { # 各モジュールに通知 RunLoop->shared->notify_modules('notification_of_message_io',$msg,$this,'in'); - + # ログイン作業中か？ if ($this->{logged_in}) { # ログイン作業中でない。 @@ -343,7 +344,7 @@ sub _receive_while_logging_in { my ($this,$first_msg) = @_; - + # まだログイン作業中であるのなら、ログインに成功したかどうかを # 最初に受け取った行が001(成功)か433(nick重複)かそれ以外かで判断する。 my $reply = $first_msg->command; @@ -354,7 +355,7 @@ $this->person($this->{current_nick}, $this->{user_shortname}, $this->{user_realname}); - + ::printmsg("Logged-in successfuly into $this->{destination}."); # 各モジュールにサーバー追加の通知を行なう。 @@ -370,6 +371,11 @@ $this->_set_to_next_nick($first_msg->param(1)); return; # 何も返さない→クライアントにはこの結果を知らせない。 } + elsif ($reply eq '437') { + # nick/channel is temporarily unavailable(この場合は nick) + $this->_set_to_next_nick($first_msg->param(1)); + return; # 何も返さない→クライアントにはこの結果を知らせない。 + } else { # それ以外。手の打ちようがないのでconnectionごと切断してしまう。 # 但し、ニューメリックリプライでなければ無視する。 @@ -388,40 +394,53 @@ my ($this,$msg) = @_; $this->person($msg->nick,$msg->name,$msg->host); # nameとhostを覚えておく。 - + if ($msg->command eq 'NICK') { # nickを変えたのが自分なら、それをクライアントには伝えない。 my $current_nick = $this->{current_nick}; if ($msg->nick eq $current_nick) { $this->{current_nick} = $msg->param(0); - - # ここで消してしまうとプラグインにすらNICKが行かなくなる。 - # 消す代わりに"do-not-send-to-clients => 1"という註釈を付ける。 - $msg->remark('do-not-send-to-clients',1); - - # ローカルnickと違っていれば、その旨を通知する。 - # 但し、networks/always-notify-new-nickが設定されていれば常に通知する。 - my $local_nick = RunLoop->shared_loop->current_nick; - if (Configuration->shared->networks->always_notify_new_nick || - $this->{current_nick} ne $local_nick) { - - RunLoop->shared_loop->broadcast_to_clients( - IRCMessage->new( - Command => 'NOTICE', - Params => [$local_nick, - "*** Your global nick in ". - $this->{network_name}. - " is currently '".$this->{current_nick}."'."])); + + if (RunLoop->shared->multi_server_mode_p) { + # ここで消してしまうとプラグインにすらNICKが行かなくなる。 + # 消す代わりに"do-not-send-to-clients => 1"という註釈を付ける。 + $msg->remark('do-not-send-to-clients',1); + + # ローカルnickと違っていれば、その旨を通知する。 + # 但し、networks/always-notify-new-nickが設定されていれば常に通知する。 + my $local_nick = RunLoop->shared_loop->current_nick; + if (Configuration->shared->networks->always_notify_new_nick || + $this->{current_nick} ne $local_nick) { + + RunLoop->shared_loop->broadcast_to_clients( + IRCMessage->new( + Command => 'NOTICE', + Params => [$local_nick, + "*** Your global nick in ". + $this->{network_name}. + " is currently '".$this->{current_nick}."'."])); + } } } $this->_NICK($msg); } elsif ($msg->command eq '433') { # nickが既に使用中 - $this->_set_to_next_nick($msg->param(1)); - - # これもクライアントには伝えない。 - $msg = undef; + if (RunLoop->shared->multi_server_mode_p) { + $this->_set_to_next_nick($msg->param(1)); + + # これもクライアントには伝えない。 + $msg = undef; + } + } + elsif ($msg->command eq '437') { + # nick/channel temporary unavaliable + if (Multicast::nick_p && RunLoop->shared->multi_server_mode_p) { + $this->_set_to_next_nick($msg->param(1)); + + # これもクライアントには伝えない。 + $msg = undef; + } } elsif ($msg->command eq 'JOIN') { $this->_JOIN($msg); @@ -460,6 +479,9 @@ elsif ($msg->command eq '332') { $this->_RPL_TOPIC($msg); } + elsif ($msg->command eq '333') { + $this->_RPL_TOPICWHOTIME($msg); + } elsif ($msg->command eq '346') { $this->_RPL_INVITELIST($msg); } @@ -537,7 +559,7 @@ my $ch = $this->{channels}->{$msg->param(0)}; if (defined $ch) { my $n_params = @{$msg->params}; - + my $plus = 0; # 現在評価中のモードが+なのか-なのか。 my $mode_char_pos = 1; # 現在評価中のmode characterの位置。 my $mode_param_offset = 0; # $mode_char_posから幾つの追加パラメタを拾ったか。 @@ -546,7 +568,7 @@ $mode_param_offset++; return $msg->param($mode_char_pos + $mode_param_offset); }; - + for (;$mode_char_pos < $n_params;$mode_char_pos += $mode_param_offset + 1) { $mode_param_offset = 0; # これは毎回リセットする。 foreach my $c (split //,$msg->param($mode_char_pos)) { @@ -594,11 +616,11 @@ sub _JOIN { my ($this,$msg) = @_; - + map { m/^([^\x07]+)(?:\x07(.*))?/; my ($ch_name,$mode) = ($1,(defined $2 ? $2 : '')); - + my $ch = $this->{channels}->{$ch_name}; if (defined $ch) { # 知っているチャンネル。もしkickedフラグが立っていたらクリア。 @@ -627,7 +649,7 @@ map { m/^([@+]*)(.+)$/; my ($mode,$nick) = ($1,$2); - + $ch->names($nick, new PersonInChannel( $this->person($nick), @@ -650,8 +672,6 @@ $ch->names($msg->nick,undef,'delete'); } } - - } split(/,/,$msg->param(0)); # 全チャンネルを走査し、このnickを持つ人物が一人も居なくなつてゐたらpeopleからも消す。 @@ -720,6 +740,10 @@ # 古いトピックを"old-topic"として註釈を付ける。 $msg->remark('old-topic', $ch->topic); $ch->topic($msg->param(1)); + + # topic_who と topic_time を指定する + $ch->topic_who($msg->prefix); + $ch->topic_time(time); } } @@ -736,13 +760,13 @@ # NAMREPLY受信中フラグを立てる $this->{receiving_namreply}->{$msg->param(2)} = 1; } - + if (defined $ch) { # @なら+s,*なら+p、=ならそのどちらでもない事が確定している。 my $ch_property = $msg->param(1); if ($ch_property eq '@') { $ch->switches('s',1); - $ch->switches('p',undef,'delete'); + $ch->switches('p',undef,'delete'); } elsif ($ch_property eq '*') { $ch->switches('s',undef,'delete'); @@ -752,11 +776,11 @@ $ch->switches('s',undef,'delete'); $ch->switches('p',undef,'delete'); } - + my @people = map { m/^([@\+]{0,2})(.+)$/; my ($mode,$nick) = ($1,$2); - + $ch->names($nick, new PersonInChannel( $this->person($nick), @@ -805,10 +829,19 @@ } } +sub _RPL_TOPICWHOTIME { + my ($this,$msg) = @_; + my $ch = $this->{channels}->{$msg->param(1)}; + if (defined $ch) { + $ch->topic_who($msg->param(2)); + $ch->topic_time($msg->param(3)); + } +} + sub _RPL_INVITELIST { my ($this,$msg) = @_; my $ch = $this->{channels}->{$msg->param(1)}; - + my $receiving_invitelist = $this->{receiving_invitelist}->{$msg->param(1)}; if (defined $receiving_invitelist && $receiving_invitelist == 1) { @@ -817,7 +850,7 @@ # INVITELIST受信中フラグを立てる $this->{receiving_invitelist}->{$msg->param(1)} = 1; } - + if (defined $ch) { # 重複防止のため、一旦deleteしてからadd。 $ch->invitelist('delete',$msg->param(2)); @@ -842,7 +875,7 @@ # EXCEPTLIST受信中フラグを立てる $this->{receiving_exceptlist}->{$msg->param(1)} = 1; } - + if (defined $ch) { # 重複防止のため、一旦deleteしてからadd。 $ch->exceptionlist('delete',$msg->param(2)); @@ -867,7 +900,7 @@ # BANLIST受信中フラグを立てる $this->{receiving_banlist}->{$msg->param(1)} = 1; } - + if (defined $ch) { # 重複防止のため、一旦deleteしてからadd。 $ch->banlist('delete',$msg->param(2)); @@ -907,11 +940,11 @@ if (defined $ch) { $ch->remarks('switches-are-known',1); } - + # 鯖がMODEを実行したことにして、_MODEに処理を代行させる。 my @args = @{$msg->params}; @args = @args[1 .. $#args]; - + $this->_MODE( new IRCMessage(Prefix => $msg->prefix, Command => 'MODE', @@ -922,7 +955,7 @@ my ($this,$failed_nick) = @_; # failed_nickの次のnickを試します。nick重複でログインに失敗した時に使います。 my $next_nick = modify_nick($failed_nick); - + my $msg_for_user = "Nick $failed_nick was already in use in the ".$this->network_name.". Trying ".$next_nick."..."; $this->send_message( new IRCMessage( @@ -950,13 +983,13 @@ $nick = substr($base,0,9 - length($next_num)) . $next_num; } } - elsif ($nick =~ /_$/ && length($nick) == 9) { + elsif ($nick =~ /_$/ && length($nick) >= 9) { # 最後の文字が_で、それ以上_を付けられない場合、それを0に。 $nick =~ s/_$/0/; } else { # 最後に_を付ける。 - if (length($nick) == 9) { + if (length($nick) >= 9) { $nick =~ s/.$/_/; } else { diff -urN tiarra-20030925/main/Multicast.pm tiarra-20030926/main/Multicast.pm --- tiarra-20030925/main/Multicast.pm 2003-09-26 12:50:58.000000000 +0900 +++ tiarra-20030926/main/Multicast.pm 2003-09-26 21:14:50.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Multicast.pm,v 1.17 2003/09/23 15:26:11 admin Exp $ +# $Id: Multicast.pm,v 1.18 2003/09/26 12:07:13 topia Exp $ # ----------------------------------------------------------------------------- # サーバーからクライアントにメッセージが流れるとき、このクラスはフィルタとして # ネットワーク名を付加します。 @@ -147,12 +147,12 @@ my ($message,$sender) = @_; $message->nick(global_to_local($message->nick,$sender)); @{$message->params} = map( global_to_local($_,$sender) ,@{$message->params}); - + my $target = $message->params->[0]; unless (nick_p($target)) { # nick(つまり自分)の場合はそのままクライアントに配布。 # この場合はチャンネルなので、ネットワーク名を付加。 - $message->params->[0] = attach($target,$sender->network_name); + $message->params->[0] = attach($target,$sender->network_name); } return $message; } @@ -163,7 +163,7 @@ my $network = $runloop->networks->{$to}; @{$message->params} = map( local_to_global($_,$network) ,@{$message->params}); - + forward_to_server($message,$to); } @@ -174,8 +174,8 @@ my $to; my $specified; ($message->params->[0],$to,$specified) = detatch($message->params->[0]); - - if ($specified) { + + if ($specified) { forward_to_server($message,$to); } else { @@ -196,10 +196,10 @@ my ($message,$sender) = @_; my $to; ($message->params->[0],$to) = detatch($message->params->[0]); - + my $network = $runloop->networks->{$to}; $message->params->[0] = local_to_global($message->params->[0],$runloop->networks->{$to}); - + # ローカルnickと送信先のグローバルnickが異なっていたら、その旨をクライアントに報告する。 # ただしWHOISの対象が自分だった場合のみ。 my $local_nick = $runloop->current_nick; @@ -212,7 +212,7 @@ Params => [$local_nick, "*** Your global nick in $to is currently '$global_nick'."])); } - + forward_to_server($message,$to); } @@ -240,7 +240,7 @@ } sub _RPL_WHOREPLY { - my ($message,$sender) = @_; + my ($message, $sender) = @_; $message->param(1,attach($message->param(1),$sender->network_name)); $message->param(5,global_to_local($message->param(5),$sender)); $message; @@ -260,7 +260,7 @@ my $g2l_cache = {}; sub _gen_g2l_translator { my $index = shift; - + unless (exists $g2l_cache->{$index}) { $g2l_cache->{$index} = sub { my ($message,$sender) = @_; @@ -331,6 +331,7 @@ '324' => _gen_attach_translator(1), # CHANNELMODEIS '331' => _gen_attach_translator(1), # NOTOPIC '332' => _gen_attach_translator(1), # TOPIC + '333' => _gen_attach_translator(1), # TOPICWHOTIME '341' => \&_RPL_INVITING, '346' => _gen_attach_translator(1), # INVITELIST '347' => _gen_attach_translator(1), # ENDOFINVITELIST @@ -397,6 +398,7 @@ '324' => _gen_detach_translator(1), # CHANNELMODEIS '331' => _gen_detach_translator(1), # NOTOPIC '332' => _gen_detach_translator(1), # TOPIC + '333' => _gen_detach_translator(1), # TOPICWHOTIME '341' => _gen_detach_translator(1), # INVITING '346' => _gen_detach_translator(1), # INVITELIST '347' => _gen_detach_translator(1), # ENDOFINVITELIST @@ -472,7 +474,7 @@ local $hijack_local_to_global = 1; eval { $client_sent->{$message->command}->($message, $sender); - }; if ($@) { + }; if ( !defined $result ) { $hijack_forward_to_server->($message, $default_network); } $result; diff -urN tiarra-20030925/tiarra tiarra-20030926/tiarra --- tiarra-20030925/tiarra 2003-09-26 12:50:56.000000000 +0900 +++ tiarra-20030926/tiarra 2003-09-26 21:14:49.000000000 +0900 @@ -5,7 +5,7 @@ # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # ----------------------------------------------------------------------------- -# $Id: tiarra,v 1.25 2003/09/25 13:15:59 topia Exp $ +# $Id: tiarra,v 1.26 2003/09/26 12:07:12 topia Exp $ # ----------------------------------------------------------------------------- require 5.006; use strict; @@ -123,6 +123,14 @@ if (&find_option('debug')) { eval q(sub debug_printmsg{printmsg('debug: '.shift)}); eval q(sub debug_mode{1;}); + $SIG{__WARN__} = sub { + use Carp; + ::printmsg(Carp::longmess(@_)); + }; + $SIG{__DIE__} = sub { + use Carp; + die(Carp::longmess(@_)); + } } else { eval q(sub debug_printmsg{}); eval q(sub debug_mode{0;});