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
|
# -----------------------------------------------------------------------------
# $Id: Pong.pm 11365 2008-05-10 14:58:28Z topia $
# -----------------------------------------------------------------------------
package System::Pong;
use strict;
use warnings;
use NumericReply;
use base qw(Module);
sub message_arrived {
my ($this,$message,$sender) = @_;
if ($message->command eq 'PING') {
my ($prefix) = do {
if ($sender->isa('IrcIO::Server')) {
undef;
} else {
RunLoop->shared_loop->sysmsg_prefix(qw(system));
}
};
my ($nick) = do {
if ($sender->isa('IrcIO::Server')) {
$sender->current_nick;
} else {
RunLoop->shared_loop->current_nick;
}
};
if ($message->n_params < 1) {
# これを送りつけてきたサーバー/クライアントにエラーを返す。
$sender->send_message(
$this->construct_irc_message(
Prefix => $prefix,
Command => ERR_NOORIGIN,
Params => [
$nick,
'No origin specified',
]));
} else {
my ($target);
if ($sender->isa('IrcIO::Server')) {
$nick = undef;
$target = $sender->server_hostname;
} else {
$target = RunLoop->shared_loop->sysmsg_prefix(qw(system));
}
# これを送りつけてきたサーバー/クライアントにPONGを送り返す。
$sender->send_message(
$this->construct_irc_message(
Prefix => $prefix,
Command => 'PONG',
Params => [
$target,
(defined $nick ? $nick : ()),
]));
}
# print "System::Pong ponged to ".$message->params->[0].".\n";
# PINGメッセージはこれ以上伝達させず、ここで消してしまう。
return undef;
}
elsif ($message->command eq 'PONG') {
# PONGメッセージはこれ以上伝達させず、ここで消してしまう。
return undef;
}
else {
return $message;
}
}
1;
=pod
info: サーバーからのPINGメッセージに対し、自動的にPONGを返す。
default: on
# これをoffにするとクライアントが自らPINGに応答せざるを得なくなりますが、
# クライアントからのPONGメッセージはデフォルトのサーバーへ送られるので
# デフォルト以外のサーバーからはPing Timeoutで落とされるなど
# 全く良い事がありません。
# 設定項目はありません。
=cut
|
