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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
# -----------------------------------------------------------------------------
# $Id: Utils.pm 11365 2008-05-10 14:58:28Z topia $
# -----------------------------------------------------------------------------
package Auto::Utils;
use strict;
use warnings;
use Module::Use qw(Auto::AliasDB);
use Auto::AliasDB;
use Multicast;
use RunLoop;
use base qw(Tiarra::IRC::NewMessageMixin);
# get_ch_name は get_raw_ch_name のエイリアス(過去互換のため)
*get_ch_name = \&get_raw_ch_name;
sub get_raw_ch_name {
# ネットワーク名抜きの送信先(チャンネル/nick)名 or undef を得る
my ($msg, $ch_place) = @_;
if (defined($msg->param($ch_place)) && $msg->param($ch_place) ne '') {
return(scalar(Multicast::detach($msg->param($ch_place))));
} else {
return undef;
}
}
sub get_full_ch_name {
# ネットワーク名付きの送信先(チャンネル/nick)名 or undef を得る
my ($msg, $ch_place) = @_;
if (defined($msg->param($ch_place)) && $msg->param($ch_place) ne '') {
return($msg->param($ch_place));
} else {
return undef;
}
}
sub sendto_channel_closure {
# チャンネル等に PRIVMSG / NOTICE を送るクロージャを返します。
# - 引数 -
# $sendto : チャンネル名 or ニック。ネットワーク名を付けて下さい。
# $command : 'PRIVMSG' or 'NOTICE'。その他のコマンドも制限はしませんが意味が無いでしょう。
# $msg : message_arrivedに渡ってきた$msg。エイリアス置換に使用されます。よって、
# 後述する $use_alias が false なら指定する必要はありません。
# その場合は undef でも渡しておきましょう。
# $sender : message_arrivedに渡ってきた$sender。送信に使います。ない場合は
# $result とともに undef を指定してください。
# $result : message_arrivedの返り値にする配列の参照。詳細は例を見ましょう。
# $use_alias : エイリアス置き換えを行うかどうか。省略可で省略した場合は
# 行うが、 $msg, $sender のどちらかが undef ならエイリアス
# 置き換えを呼び出せないので行わない。
# $extra_callbacks
# : 追加のエイリアス置換コールバック。省略可。
#
# エイリアス置換・コールバックに関しては Auto::AliasDB を参照してください。
#
# - 返り値 -
# $send_message
# $send_message
# : クロージャ。第一引数にメッセージ、第二引数以降に追加のエイリアス(省略可能)を指定して呼び出す。
# メッセージとしてundefが渡された場合は、何もせずに終了する。
#
# - 使用例 -
# sub message_arrived {
# my ($this,$msg,$sender) = @_;
# my @result = ($msg);
# my $send_message =
# sendto_channel_closure('#test@ircnet', 'NOTICE', $msg, $sender, \@result);
# $send_message->('message', 'hoge' => 'moge');
# return @result;
# }
#
my ($sendto, $command, $msg, $sender, $result, $use_alias, $extra_callbacks) = @_;
$use_alias = 1 if (!defined $use_alias && defined $msg && defined $sender);
$extra_callbacks = [] unless defined $extra_callbacks;
return sub {
my ($line,%extra_replaces) = @_;
return if !defined $line;
foreach my $str ((ref($line) eq 'ARRAY') ? @$line : $line) {
my $msg_to_send = __PACKAGE__->construct_irc_message(
Command => $command,
Params => ['', # 後で設定
($use_alias ? Auto::AliasDB->shared->stdreplace_add(
$msg->prefix || $sender->fullname,
$str,
$extra_callbacks,
$msg,
$sender,
%extra_replaces)
: $str)]);
my ($rawname, $network_name, $specified_network) =
Multicast::detach($sendto);
my $get_network_name = sub {
$specified_network ? $network_name :
Configuration->shared_conf->networks->default;
};
my $sendto_client = Multicast::attach_for_client($rawname, $network_name);
if (!defined $sender) {
# 鯖にはチャンネル名にネットワーク名を付けない。
my $for_server = $msg_to_send->clone;
$sender = RunLoop->shared_loop->network($get_network_name->());
if (defined $sender) {
$for_server->param(0, $rawname);
$sender->send_message($for_server);
}
# クライアントにはチャンネル名にネットワーク名を付ける。
# また、クライアントに送られる時にはPrefixがそのユーザーに設定されるよう註釈を付ける。
my $for_client = $msg_to_send->clone;
$for_client->param(0, $sendto_client);
$for_client->remark('fill-prefix-when-sending-to-client',1);
RunLoop->shared_loop->broadcast_to_clients($for_client);
} elsif ($sender->isa('IrcIO::Server')) {
# 鯖にはチャンネル名にネットワーク名を付けない。
my $for_server = $msg_to_send->clone;
$for_server->param(0, $rawname);
$sender->send_message($for_server);
# クライアントにはチャンネル名にネットワーク名を付ける。
# また、クライアントに送られる時にはPrefixがそのユーザーに設定されるよう註釈を付ける。
my $for_client = $msg_to_send->clone;
$for_client->param(0, $sendto_client);
$for_client->remark('fill-prefix-when-sending-to-client',1);
push @$result,$for_client;
} elsif ($sender->isa('IrcIO::Client')) {
# チャンネル名にネットワーク名を付ける。
my $for_server = $msg_to_send->clone;
$for_server->param(0, $sendto);
push @$result,$for_server;
my $for_client = $msg_to_send->clone;
$for_client->prefix($sender->fullname);
$for_client->param(0, $sendto_client);
$sender->send_message($for_client);
}
}
};
}
sub generate_reply_closures {
# 送信者に NOTICE で返答するクロージャを返します。
# - 引数 -
# $msg : message_arrivedに渡ってきた$msg。
# $sender : message_arrivedに渡ってきた$sender。
# $result : message_arrivedの返り値にする配列の参照。詳細は例を見ましょう。
# $use_alias : エイリアス置き換えを行うかどうか。省略可、省略した場合は行う。
# $extra_callbacks
# : 追加のエイリアス置換コールバック。省略可。
# $ch_place : チャンネル名が存在する $msg->param 内部の位置を指定します。省略時は0(先頭)です。
#
# エイリアス置換・コールバックに関しては Auto::AliasDB を参照してください。
#
# - 返り値 -
# ($get_raw_ch_name, $reply, $reply_as_priv, $reply_anywhere, $get_full_ch_name)
# $get_raw_ch_name : クロージャ。ネットワーク名無しのチャンネル名 or undef を返します。
# $reply : クロージャ。チャンネルに返答します。
# $reply_as_priv : クロージャ。送信者に直接 priv で返答します。
# $reply_anywhere : クロージャ。チャンネルが有効であれば $reply が、そうでなければ $reply_as_priv です。
# $get_full_ch_name : クロージャ。ネットワーク名付きのチャンネル名 or undef を返します。
#
# $reply* は第一引数にメッセージ、第二引数以降に追加のエイリアス(省略可能)を指定して呼び出します。
# 第一引数にundefが渡された場合は、何もせずに終了します。
#
# - 使用例 -
# sub message_arrived {
# my ($this,$msg,$sender) = @_;
# my @result = ($msg);
# my ($get_ch_name, $reply, $reply_as_priv, $reply_anywhere) =
# generate_reply_closures($msg, $sender, \@result);
# $reply_anywhere->('message', 'hoge' => 'moge');
# return @result;
# }
#
# - 備考 -
# $get_raw_ch_name がクロージャなのは過去との互換性のため、
# $get_full_ch_name がクロージャーなのは共通性のためです。
my ($msg, $sender, $result, $use_alias, $extra_callbacks, $ch_place) = @_;
$use_alias = 1 unless defined $use_alias;
$extra_callbacks = [] unless defined $extra_callbacks;
$ch_place = 0 unless defined $ch_place;
my $raw_ch_name = get_raw_ch_name($msg, $ch_place);
my $get_raw_ch_name = sub () {
$raw_ch_name;
};
my $full_ch_name = get_full_ch_name($msg, $ch_place);
my $get_full_ch_name = sub () {
$full_ch_name;
};
my $reply = sub {
sendto_channel_closure($msg->param($ch_place), 'NOTICE', $msg, $sender, $result,
$use_alias, $extra_callbacks)->(@_, 'channel' => $raw_ch_name);
};
my $reply_as_priv = sub {
my ($line,%extra_replaces) = @_;
return if !defined $line;
foreach my $str ((ref($line) eq 'ARRAY') ? @$line : $line) {
$sender->send_message(__PACKAGE__->construct_irc_message(
Command => 'NOTICE',
Params => [$msg->nick,
($use_alias ? Auto::AliasDB->shared->stdreplace_add(
$msg->prefix,
$str,
$extra_callbacks,
$msg,
$sender,
%extra_replaces)
: $str)]));
}
};
my $reply_anywhere = sub {
if (defined($raw_ch_name) && Multicast::nick_p($raw_ch_name)) {
return $reply_as_priv;
} else {
return $reply;
}
};
return ($get_raw_ch_name,$reply,$reply_as_priv,$reply_anywhere->(),$get_full_ch_name);
}
1;
|
