@@ -211,6 +238,8 @@
Channel::Freeze
+
Channel::Ignore
+
Channel::Join::Connect
Channel::Join::Invite
diff -urN tiarra-20050501/doc/module-toc.html tiarra-20050624/doc/module-toc.html
--- tiarra-20050501/doc/module-toc.html 2005-05-01 21:44:28.000000000 +0900
+++ tiarra-20050624/doc/module-toc.html 2005-06-24 09:02:32.000000000 +0900
@@ -65,6 +65,8 @@
Channel::Freeze 特定のチャンネルの発言を、一時的に受信するのをやめる。
+
Channel::Ignore 指定されたチャンネルの存在を、様々なメッセージから消去する。
+
Channel::Join::Connect サーバーに初めて接続した時、指定したチャンネルに入るモジュール。
Channel::Join::Invite 招待されたらそのチャンネルに入る。
diff -urN tiarra-20050501/main/IrcIO/Client.pm tiarra-20050624/main/IrcIO/Client.pm
--- tiarra-20050501/main/IrcIO/Client.pm 2005-05-01 21:44:26.000000000 +0900
+++ tiarra-20050624/main/IrcIO/Client.pm 2005-06-24 09:02:18.000000000 +0900
@@ -1,5 +1,5 @@
# -----------------------------------------------------------------------------
-# $Id: Client.pm 866 2005-03-26 16:57:29Z topia $
+# $Id: Client.pm 900 2005-05-02 14:58:17Z topia $
# -----------------------------------------------------------------------------
# IrcIO::Clientはクライアントからの接続を受け、
# IRCメッセージをやり取りするクラスです。
@@ -107,15 +107,16 @@
# $ foo=bar;key=value $
# $foo =bar;key= value $
- my $key = qr{[^=]+?}; # キーとして許されるパターン
+ my $key = qr{[^=:]+?}; # キーとして許されるパターン
my $value = qr{[^;]*?}; # 値として許されるパターン
- my $lastpair = qr{$key\s*=\s*$value};
+ my $sep = qr{[:=]};
+ my $lastpair = qr{$key\s*$sep\s*$value};
my $pair = qr{$lastpair\s*;};
my $line = qr{^\$(?:\s*($pair)\s*)*\s*($lastpair)\s*\$$};
if (my @pairs = ($realname =~ m/$line/g)) {
%{$this->{options}} = map {
- m/^\s*($key)\s*=\s*($value)\s*;?$/;
+ m/^\s*($key)\s*$sep\s*($value)\s*;?$/;
} grep {
defined;
} @pairs;
@@ -258,97 +259,111 @@
}
$this->{logging_in} = 0;
- $this->send_message(
- $this->construct_irc_message(Prefix => $prefix,
- Command => RPL_WELCOME,
- Params => [$this->{nick},'Welcome to the Internet Relay Network '.$this->fullname_from_client]));
-
- my $current_nick = $this->_runloop->current_nick;
- if ($this->{nick} ne $current_nick) {
- # クライアントが送ってきたnickとローカルのnickが食い違っているので正しいnickを教える。
+ # 実際にはループではない。
+ while (1) {
$this->send_message(
- $this->construct_irc_message(Prefix => $this->fullname_from_client,
- Command => 'NICK',
- Param => $current_nick));
- }
+ $this->construct_irc_message(Prefix => $prefix,
+ Command => RPL_WELCOME,
+ Params => [$this->{nick},'Welcome to the Internet Relay Network '.$this->fullname_from_client]));
+
+ my $current_nick = $this->_runloop->current_nick;
+ if ($this->{nick} ne $current_nick) {
+ # クライアントが送ってきたnickとローカルのnickが食い違っているので正しいnickを教える。
+ $this->send_message(
+ $this->construct_irc_message(Prefix => $this->fullname_from_client,
+ Command => 'NICK',
+ Param => $current_nick));
+ }
- my $send_message = sub {
- my ($command, @params) = @_;
- $this->send_message(
- $this->construct_irc_message(
- Prefix => $prefix,
- Command => $command,
- Params => [$current_nick,
- @params],
- ));
- };
-
- map {
- # ローカルnickとグローバルnickが食い違っていたらその旨を伝える。
- my $network_name = $_->network_name;
- my $global_nick = $_->current_nick;
- if ($global_nick ne $current_nick) {
+ my $send_message = sub {
+ my ($command, @params) = @_;
$this->send_message(
$this->construct_irc_message(
- Prefix => $this->_runloop->sysmsg_prefix(qw(priv system)),
- Command => 'NOTICE',
+ Prefix => $prefix,
+ Command => $command,
Params => [$current_nick,
- "*** Your global nick in $network_name is currently '$global_nick'."]));
- }
- } values %{$this->_runloop->networks};
-
- $send_message->(RPL_YOURHOST, "Your host is $prefix, running version ".::version());
- if (!$this->_runloop->multi_server_mode_p) {
- # single server mode
- my $network = ($this->_runloop->networks_list)[0];
-
- if (defined $network) {
- # send isupport
- my $msg_tmpl = $this->construct_irc_message(
- Prefix => $prefix,
- Command => RPL_ISUPPORT,
- Params => [$current_nick],
- );
- # last param is reserved for 'are supported...'
- # and first param for nick
- my $max_params = $this->irc_message_class->MAX_PARAMS - 2;
- my @params = ();
- my $length = 0;
- my $flush_msg = sub {
- if (@params) {
- my $msg = $msg_tmpl->clone;
- $msg->push(@params);
- $msg->push('are supported by this server');
- $this->send_message($msg);
- }
- @params = ();
- $length = 0;
- };
- foreach my $key (keys %{$network->isupport}) {
- my $value = $network->isupport->{$key};
- my $str = length($value) ? ($key.'='.$value) : $key;
- $length += length($str) + 1; # $str and space
- # 余裕を見て400バイトを越えたら行を分ける。
- if ($length >= 400 || scalar(@params) >= $max_params) {
- $flush_msg->();
- $length = length($str);
+ @params],
+ ));
+ };
+
+ map {
+ # ローカルnickとグローバルnickが食い違っていたらその旨を伝える。
+ my $network_name = $_->network_name;
+ my $global_nick = $_->current_nick;
+ if ($global_nick ne $current_nick) {
+ $this->send_message(
+ $this->construct_irc_message(
+ Prefix => $this->_runloop->sysmsg_prefix(qw(priv system)),
+ Command => 'NOTICE',
+ Params => [$current_nick,
+ "*** Your global nick in $network_name is currently '$global_nick'."]));
+ }
+ } values %{$this->_runloop->networks};
+
+ $send_message->(RPL_YOURHOST, "Your host is $prefix, running version ".::version());
+ if (!$this->_runloop->multi_server_mode_p) {
+ # single server mode
+ my $network = ($this->_runloop->networks_list)[0];
+
+ if (defined $network) {
+ # send isupport
+ my $msg_tmpl = $this->construct_irc_message(
+ Prefix => $prefix,
+ Command => RPL_ISUPPORT,
+ Params => [$current_nick],
+ );
+ # last param is reserved for 'are supported...'
+ # and first param for nick
+ my $max_params = $this->irc_message_class->MAX_PARAMS - 2;
+ my @params = ();
+ my $length = 0;
+ my $flush_msg = sub {
+ if (@params) {
+ my $msg = $msg_tmpl->clone;
+ $msg->push(@params);
+ $msg->push('are supported by this server');
+ $this->send_message($msg);
+ }
+ @params = ();
+ $length = 0;
+ };
+ foreach my $key (keys %{$network->isupport}) {
+ my $value = $network->isupport->{$key};
+ my $str = length($value) ? ($key.'='.$value) : $key;
+ $length += length($str) + 1; # $str and space
+ # 余裕を見て400バイトを越えたら行を分ける。
+ if ($length >= 400 || scalar(@params) >= $max_params) {
+ $flush_msg->();
+ $length = length($str);
+ }
+ push(@params, $str);
}
- push(@params, $str);
+ $flush_msg->();
}
- $flush_msg->();
}
- }
- $send_message->(RPL_MOTDSTART, "- $prefix Message of the Day -");
- foreach my $line (main::get_credit()) {
- $send_message->(RPL_MOTD, "- ".$line);
- }
- $send_message->(RPL_ENDOFMOTD, "End of MOTD command.");
+ $send_message->(RPL_MOTDSTART, "- $prefix Message of the Day -");
+ foreach my $line (main::get_credit()) {
+ $send_message->(RPL_MOTD, "- ".$line);
+ }
+ $send_message->(RPL_ENDOFMOTD, "End of MOTD command.");
+
+ # クライアントに出力。
+ # その結果切断されたらループを抜ける。
+ $this->flush;
+ last unless $this->connected;
+
+ # joinしている全てのチャンネルの情報をクライアント送る。
+ $this->inform_joinning_channels;
+
+ # 切断されていたらループを抜ける。
+ last unless $this->connected;
- # joinしている全てのチャンネルの情報をクライアント送る。
- $this->inform_joinning_channels;
+ # 各モジュールにクライアント追加の通知を出す。
+ $this->_runloop->notify_modules('client_attached',$this);
- # 各モジュールにクライアント追加の通知を出す。
- $this->_runloop->notify_modules('client_attached',$this);
+ # 必ずループを抜ける。
+ last;
+ }
}
}
# ログイン作業中にクライアントから受け取ったいかなるメッセージもサーバーには送らない。
@@ -543,6 +558,11 @@
# エラーメッセージは表示するが、送信処理は続ける
$this->_runloop->notify_error(__PACKAGE__." hook call error: $@");
}
+
+ # クライアントに出力。
+ # その結果切断されたら関数を抜ける。
+ $this->flush;
+ last CONNECTING unless $this->connected;
};
my %channels = map {
@@ -554,22 +574,27 @@
} values %{$network->channels};
} values %{$this->_runloop->networks};
- # Mask を使って、マッチしたものを出力
- foreach ($this->_conf_networks->
- fixed_channels('block')->channel('all')) {
- my $mask = $_;
- foreach (keys %channels) {
- my $ch_name = $_;
- if (Mask::match($mask, $ch_name)) {
- $send_channelinfo->(@{$channels{$ch_name}});
- delete $channels{$ch_name};
+ CONNECTING:
+ while (1) {
+ # Mask を使って、マッチしたものを出力
+ foreach ($this->_conf_networks->
+ fixed_channels('block')->channel('all')) {
+ my $mask = $_;
+ foreach (keys %channels) {
+ my $ch_name = $_;
+ if (Mask::match($mask, $ch_name)) {
+ $send_channelinfo->(@{$channels{$ch_name}});
+ delete $channels{$ch_name};
+ }
}
}
- }
- # のこりを出力
- foreach (values %channels) {
- $send_channelinfo->(@$_);
+ # のこりを出力
+ foreach (values %channels) {
+ $send_channelinfo->(@$_);
+ }
+
+ last;
}
}
diff -urN tiarra-20050501/main/Tiarra/Encoding/Encode.pm tiarra-20050624/main/Tiarra/Encoding/Encode.pm
--- tiarra-20050501/main/Tiarra/Encoding/Encode.pm 2005-05-01 21:44:27.000000000 +0900
+++ tiarra-20050624/main/Tiarra/Encoding/Encode.pm 2005-06-24 09:02:19.000000000 +0900
@@ -1,5 +1,5 @@
# -----------------------------------------------------------------------------
-# $Id: Encode.pm 832 2005-03-08 02:19:34Z topia $
+# $Id: Encode.pm 902 2005-05-15 01:38:09Z topia $
# -----------------------------------------------------------------------------
# Encoding with Encode
# -----------------------------------------------------------------------------
@@ -15,6 +15,9 @@
use Tiarra::OptionalModules;
use base qw(Tiarra::Encoding);
+# we can't support if Encode::Guess->renew is not defined.
+die 'Please use latest Encode to use.' unless Encode::Guess->can('renew');
+
our %encoding_names = ( # please specify _Encode.pm's canonical_ name.
sjis => 'cp932', # compatible with unijp
ucs2 => 'UCS-2BE',
diff -urN tiarra-20050501/main/Tiarra/Encoding.pm tiarra-20050624/main/Tiarra/Encoding.pm
--- tiarra-20050501/main/Tiarra/Encoding.pm 2005-05-01 21:44:27.000000000 +0900
+++ tiarra-20050624/main/Tiarra/Encoding.pm 2005-06-24 09:02:20.000000000 +0900
@@ -1,5 +1,5 @@
# -----------------------------------------------------------------------------
-# $Id: Encoding.pm 833 2005-03-08 02:19:59Z topia $
+# $Id: Encoding.pm 901 2005-05-15 01:27:37Z topia $
# -----------------------------------------------------------------------------
# Tiarra Encoding Manager
# -----------------------------------------------------------------------------
@@ -12,6 +12,7 @@
qr/(uni-?jp|unicode(::|-)japanese)/i => 'UniJP',
qr/encode/i => 'Encode',
);
+our %tried_providers;
sub new {
my ($class, $str, $icode, $encode, %options) = @_;
@@ -54,8 +55,11 @@
}
sub _is_supported {
- my $retval = eval 'require ' . shift->_get_module_name(@_);
+ my $modname = shift->_get_module_name(@_);
+ return $tried_providers{$modname} if defined $tried_providers{$modname};
+ my $retval = eval 'require ' . $modname;
warn $@ if $@;
+ $tried_providers{$modname} = $retval;
return $retval;
}
diff -urN tiarra-20050501/module/Channel/Ignore.pm tiarra-20050624/module/Channel/Ignore.pm
--- tiarra-20050501/module/Channel/Ignore.pm 1970-01-01 09:00:00.000000000 +0900
+++ tiarra-20050624/module/Channel/Ignore.pm 2005-06-24 09:02:32.000000000 +0900
@@ -0,0 +1,161 @@
+# -----------------------------------------------------------------------------
+# $Id: Ignore.pm 907 2005-06-23 23:56:57Z topia $
+# -----------------------------------------------------------------------------
+# copyright (C) 2005 Topia
. all rights reserved.
+package Channel::Ignore;
+use strict;
+use warnings;
+use base qw(Module);
+use Mask;
+use Multicast;
+use NumericReply;
+
+sub message_io_hook {
+ my ($this,$msg,$io,$type) = @_;
+
+ if ($io->isa('IrcIO::Server')) {
+ if ($type eq 'in') {
+ my $numeric = NumericReply::fetch_name($msg->command);
+ my $method = 'cmd_'.($numeric || $msg->command);
+ if ($this->can($method)) {
+ return $this->$method($msg, $io);
+ }
+ }
+ }
+
+ $msg;
+}
+
+*cmd_NOTICE = \&cmd_PRIVMSG;
+*cmd_PART = \&cmd_PRIVMSG;
+*cmd_INVITE = \&cmd_PRIVMSG;
+*cmd_TOPIC = \&cmd_PRIVMSG;
+*cmd_MODE = \&cmd_PRIVMSG;
+*cmd_KICK = \&cmd_PRIVMSG;
+sub cmd_PRIVMSG {
+ my ($this,$msg,$io) = @_;
+
+ my $ch_short = $msg->param(0);
+ my $ch_long = Multicast::attach($ch_short, $io->network_name);
+ if (!Multicast::channel_p($ch_short)) {
+ $ch_long = 'priv@'.$io->network_name;
+ }
+
+ if ($this->ignore_channel_p($ch_long)) {
+ undef;
+ }
+ else {
+ $msg;
+ }
+}
+
+sub cmd_JOIN {
+ my ($this,$msg,$io) = @_;
+ my @channels; # ｃ潟鴻罕
+ foreach my $channel (split m/,/,$msg->param(0)) {
+ my ($ch_short,$mode) = ($channel =~ m/^([^\x07]+)(?:\x07(.*))?/);
+ my $ch_long = Multicast::attach($ch_short, $io->network_name);
+ if (!$this->ignore_channel_p($ch_long)) {
+ push @channels,$channel;
+ }
+ }
+
+ if (@channels > 0) {
+ # 罕腟ｃ潟障罧ｃ
+ $msg->param(0,join(',',@channels));
+ }
+ else {
+ $msg = undef;
+ }
+
+ $msg;
+}
+
+sub cmd_NJOIN {
+ my ($this,$msg,$io) = @_;
+ my $ch_short = $msg->param(0);
+ my $ch_long = Multicast::attach($ch_short, $io->network_name);
+ if ($this->ignore_channel_p($ch_long)) {
+ $msg = undef;
+ }
+
+ $msg;
+}
+
+*cmd_QUIT = \&cmd_NICK;
+sub cmd_NICK {
+ my ($this,$msg,$io) = @_;
+
+ # 綵演帥若ｃ潟鴻緇鴻若篁
+ my $no_ignore;
+ my $nick = $msg->nick;
+
+ foreach (grep { defined $_->names($nick) } $io->channels_list) {
+ my $ch_long = Multicast::attach($_,$io->network_name);
+ if (!$this->ignore_channel_p($ch_long)) {
+ $no_ignore = 1;
+ last;
+ }
+ }
+
+ if ($no_ignore) {
+ $msg;
+ }
+ else {
+ undef;
+ }
+}
+
+sub cmd_RPL_NAMREPLY {
+ my ($this,$msg,$io) = @_;
+
+ my $ch_short = $msg->param(2);
+ my $ch_long = Multicast::attach($ch_short, $io->network_name);
+ if ($this->ignore_channel_p($ch_long)) {
+ $msg = undef;
+ }
+
+ $msg;
+}
+
+*cmd_RPL_CHANNELMODEIS = \&cmd_RPL_ENDOFNAMES;
+*cmd_RPL_TOPIC_WHO_TIME = \&cmd_RPL_ENDOFNAMES;
+*cmd_RPL_TOPIC = \&cmd_RPL_ENDOFNAMES;
+sub cmd_RPL_ENDOFNAMES {
+ my ($this,$msg,$io) = @_;
+
+ my $ch_short = $msg->param(1);
+ my $ch_long = Multicast::attach($ch_short, $io->network_name);
+ if ($this->ignore_channel_p($ch_long)) {
+ $msg = undef;
+ }
+
+ $msg;
+}
+
+sub ignore_channel_p {
+ my ($this,$ch_long) = @_;
+ Mask::match_deep([$this->config->mask('all')],$ch_long);
+}
+
+1;
+
+=pod
+info: 絎ｃ潟絖罕＜祉若吾羔ｻ
+default: off
+
+# 絲乗院ｃｃ潟JOINPARTINVITEQUITNICKNAMESNJOIN羔ｻ
+
+# 羈
+# - 罘純障絎茖筝с筝桁障ｃ障
+# - 泣若篆＜蚊莨若帥障с違障
+# - 罘純篏帥ｃ tiarra 筝羌 multi-server-mode tiarra 臀с
+
+# ｃ潟絎臂
+# 障priv翫priv@若絖ｃ潟篁ｃ潟違茵
+# 後: mask: <ｃ潟鴻>
+mask: #example@example
+=cut
+
+
+1;