1# ----------------------------------------------------------------------------- 2# $Id: Cotton.pm 11365 2008-05-10 14:58:28Z topia $ 3# ----------------------------------------------------------------------------- 4# copyright (C) 2004 Topia <topia@clovery.jp>. all rights reserved. 5package Client::Cotton; 6use strict; 7use warnings; 8use base qw(Module); 9use Mask; 10use Multicast; 11use Tiarra::Utils; 12 13sub PART_SHIELD_EXPIRE_TIME (){5 * 60;} 14 15sub new { 16 my $class = shift; 17 my $this = $class->SUPER::new(@_); 18 $this; 19} 20 21sub message_io_hook { 22 my ($this,$msg,$io,$type) = @_; 23 24 if ($io->isa('IrcIO::Client') && 25 $this->is_cotton($io)) { 26 if (utils->cond_yesno($this->config->use_part_shield) && 27 $type eq 'in' && 28 $msg->command eq 'PART' && 29 Multicast::channel_p($msg->param(0)) && 30 !defined $msg->param(1)) { 31 my ($chan_short, $network_name) = Multicast::detach($msg->param(0)); 32 my $network = $this->_runloop->network($network_name); 33 if (defined $network) { 34 my $expire = $network->remark(__PACKAGE__.'/part-shield/expire'); 35 my $remark = $io->remark(__PACKAGE__.'/part-shield/'.$network_name); 36 if (defined $expire && 37 $expire >= time()) { 38 if (!defined $remark || 39 (defined $remark->{channels} && 40 !defined $remark->{channels}->{$chan_short})) { 41 $remark->{channels}->{$chan_short} = 1; 42 return undef; 43 } 44 } else { 45 # remove expired network info 46 $network->remark(__PACKAGE__.'/part-shield/expire', undef, 'delete'); 47 $io->remark(__PACKAGE__.'/part-shield/'.$network_name, undef, 'delete'); 48 } 49 } 50 } 51 } 52 return $msg; 53} 54 55sub connected_to_server { 56 my ($this,$server,$new_connection) = @_; 57 58 if (!$new_connection) { 59 # reconnect 60 $server->remark(__PACKAGE__.'/part-shield/expire', time() + PART_SHIELD_EXPIRE_TIME); 61 } 62} 63 64sub is_cotton { 65 my ($this, $client) = @_; 66 67 return 1 if defined $client->remark('client-version') && 68 $client->remark('client-version') =~ /(Cotton|Unknown) Client/; 69 return 1 if defined $client->option('client-type') && 70 $client->option('client-type') =~ /(cotton|unknown)/; 71 return 0; 72} 73 741; 75=pod 76info: Cotton の行うおかしな動作のいくつかを無視する 77default: off 78section: important 79 80# 該当クライアントのオプション client-type に cotton や unknown と指定するか、 81# Client::GetVersion を利用してクライアントのバージョンを取得するように 82# してください。 83 84# part shield (rejoin 時に自動で行われる part の無視)を使用するか 85use-part-shield: 1 86 87=cut 88