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