line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mojo::IRC::Server::Chinese::User; |
2
|
1
|
|
|
1
|
|
4
|
use Mojo::IRC::Server::Chinese::Base 'Mojo::IRC::Server::Chinese::Object'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
5
|
|
3
|
1
|
|
|
1
|
|
4
|
use List::Util qw(first); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
1711
|
|
4
|
|
|
|
|
|
|
has [qw(id name io)]; |
5
|
|
|
|
|
|
|
has user => '*'; |
6
|
|
|
|
|
|
|
has pass => undef; |
7
|
|
|
|
|
|
|
has nick => '*'; |
8
|
|
|
|
|
|
|
has mode => 'i'; |
9
|
|
|
|
|
|
|
has buffer => ''; |
10
|
|
|
|
|
|
|
has virtual => 0; |
11
|
|
|
|
|
|
|
has host => sub{$_[0]->virtual?"virtualhost":"hidden"}; |
12
|
|
|
|
|
|
|
has port => sub{$_[0]->virtual?"virtualport":"hidden"}; |
13
|
|
|
|
|
|
|
has ctime => sub{time()}; |
14
|
|
|
|
|
|
|
has 'last_speak_time'; |
15
|
|
|
|
|
|
|
has 'last_active_time'; |
16
|
|
|
|
|
|
|
has ping_count => 0; |
17
|
|
|
|
|
|
|
has close_reason => undef; |
18
|
|
|
|
|
|
|
has channel => sub{[]}; |
19
|
|
|
|
|
|
|
has realname => 'unset'; |
20
|
|
|
|
|
|
|
has is_quit => 0; |
21
|
|
|
|
|
|
|
has is_away => 0; |
22
|
|
|
|
|
|
|
has away_info => undef; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub is_registered { |
25
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
26
|
0
|
0
|
|
|
|
|
if(@_==0){return $s->{is_registered}} |
|
0
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
else{ |
28
|
0
|
|
|
|
|
|
$s->{is_registered} = $_[0]; |
29
|
0
|
|
|
|
|
|
$s->{_server}->emit(user_registered=>$s); |
30
|
|
|
|
|
|
|
} |
31
|
0
|
|
|
|
|
|
return $s; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
sub is_virtual { |
34
|
0
|
|
|
0
|
0
|
|
$_[0]->virtual; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
sub away { |
37
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
38
|
0
|
|
|
|
|
|
my $away_info = shift; |
39
|
0
|
|
|
|
|
|
$s->send($s->serverident,"306",$s->nick,"你已经被标记为离开"); |
40
|
0
|
|
|
|
|
|
$s->is_away(1); |
41
|
0
|
|
|
|
|
|
$s->away_info($away_info); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
sub back { |
44
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
45
|
0
|
|
|
|
|
|
$s->send($s->serverident,"305",$s->nick,"你不再被标记为离开"); |
46
|
0
|
|
|
|
|
|
$s->is_away(0); |
47
|
0
|
|
|
|
|
|
$s->away_info(undef); |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
sub quit{ |
50
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
51
|
0
|
|
0
|
|
|
|
my $quit_reason = shift || ""; |
52
|
0
|
|
|
|
|
|
$s->broadcast($s->ident,"QUIT",$quit_reason); |
53
|
0
|
|
|
|
|
|
$s->info("[" . $s->name . "] 已退出($quit_reason)"); |
54
|
0
|
0
|
|
|
|
|
$s->io->close_gracefully() if not $s->is_virtual; |
55
|
0
|
|
|
|
|
|
$s->{_server}->remove_user($s); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
sub ident{ |
58
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
59
|
0
|
|
|
|
|
|
return $s->nick . '!' . $s->user . '@' . $s->host; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
sub set_nick{ |
62
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
63
|
0
|
|
|
|
|
|
my $nick = shift; |
64
|
0
|
|
|
|
|
|
my $user = $s->search_user(nick=>$nick); |
65
|
0
|
0
|
0
|
|
|
|
if(defined $user and $user->id ne $s->id){ |
66
|
0
|
0
|
|
|
|
|
if($user->is_virtual){ |
67
|
0
|
|
|
|
|
|
$user->quit("虚拟帐号被移除"); |
68
|
0
|
|
|
0
|
|
|
$s->once(close=>sub{$s->{_server}->add_user($user)}); |
|
0
|
|
|
|
|
|
|
69
|
0
|
|
|
|
|
|
$s->broadcast($s->ident,NICK => $nick); |
70
|
0
|
|
|
|
|
|
$s->info("[" . $s->nick . "] 修改昵称为 [$nick]"); |
71
|
0
|
|
|
|
|
|
$s->nick($nick); |
72
|
0
|
|
|
|
|
|
$s->name($nick); |
73
|
0
|
0
|
0
|
|
|
|
if(!$s->is_registered and $s->nick ne "*" and $s->user ne "*"){ |
|
|
|
0
|
|
|
|
|
74
|
0
|
|
|
|
|
|
$s->is_registered(1); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
else{ |
78
|
0
|
|
|
|
|
|
$s->send($s->serverident,"433",$s->nick,$nick,'昵称已经被使用'); |
79
|
0
|
|
|
|
|
|
$s->info("昵称 [$nick] 已经被使用"); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
else{ |
83
|
0
|
0
|
0
|
|
|
|
if(defined $s->{_server}->auth and ref $s->{_server}->auth eq "CODE"){ |
84
|
0
|
0
|
|
|
|
|
if(! $s->{_server}->auth->($nick,$s->user,$s->pass)){ |
85
|
0
|
|
|
|
|
|
$s->send($s->serverident,"464",$s->nick,"认证失败"); |
86
|
0
|
|
|
|
|
|
return; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
} |
89
|
0
|
|
|
|
|
|
$s->broadcast($s->ident,NICK => $nick); |
90
|
0
|
|
|
|
|
|
$s->info("[" . $s->nick . "] 修改昵称为 [$nick]"); |
91
|
0
|
|
|
|
|
|
$s->nick($nick); |
92
|
0
|
|
|
|
|
|
$s->name($nick); |
93
|
0
|
0
|
0
|
|
|
|
if(!$s->is_registered and $s->nick ne "*" and $s->user ne "*"){ |
|
|
|
0
|
|
|
|
|
94
|
0
|
|
|
|
|
|
$s->is_registered(1); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
sub set_mode{ |
99
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
100
|
0
|
|
|
|
|
|
my $mode = shift; |
101
|
0
|
|
|
|
|
|
my %mode = map {$_=>1} split //,$s->mode; |
|
0
|
|
|
|
|
|
|
102
|
0
|
0
|
|
|
|
|
if(substr($mode,0,1) eq "+"){ |
|
|
0
|
|
|
|
|
|
103
|
0
|
|
|
|
|
|
$mode{$_}=1 for split //,substr($mode,1,); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
elsif(substr($mode,0,1) eq "-"){ |
106
|
0
|
|
|
|
|
|
delete $mode{$_} for split //,substr($mode,1,); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
else{ |
109
|
0
|
|
|
|
|
|
%mode = (); |
110
|
0
|
|
|
|
|
|
$mode{$_}=1 for split //,$mode; |
111
|
|
|
|
|
|
|
} |
112
|
0
|
|
|
|
|
|
$s->mode(join "",keys %mode); |
113
|
0
|
|
|
|
|
|
$s->send($s->ident,"MODE",$s->nick,$mode); |
114
|
0
|
|
|
|
|
|
$s->info("[" . $s->nick . "] 模式设置为: " . $s->mode); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
sub join_channel{ |
117
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
118
|
0
|
|
|
|
|
|
my $channel; |
119
|
0
|
0
|
|
|
|
|
$channel = ref($_[0]) eq "Mojo::IRC::Server::Chinese::Channel"?$_[0]:$s->search_channel(id=>$_[0]); |
120
|
0
|
0
|
|
|
|
|
return if not defined $channel; |
121
|
0
|
0
|
|
|
|
|
if(not $s->is_join_channel($channel->id)){ |
122
|
0
|
|
|
|
|
|
push @{$s->channel},$channel->id; |
|
0
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
|
$channel->add_user($s->id); |
124
|
0
|
|
|
|
|
|
$channel->broadcast($s->ident,"JOIN",$channel->name); |
125
|
|
|
|
|
|
|
} |
126
|
0
|
|
|
|
|
|
else{$s->send($s->ident,"JOIN",$channel->name);} |
127
|
0
|
|
|
|
|
|
$s->send($s->serverident,"332",$s->nick,$channel->name,$channel->topic); |
128
|
0
|
|
|
|
|
|
$s->send($s->serverident,"353",$s->nick,'=',$channel->name,join " ",map {$_->nick} $channel->users); |
|
0
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
$s->send($s->serverident,"366",$s->nick,$channel->name,"End of NAMES list"); |
130
|
|
|
|
|
|
|
#$s->send($s->serverident,"329",$s->nick,$channel->name,$channel->ctime); |
131
|
0
|
|
|
|
|
|
$s->info("[" . $s->name . "] 加入频道 " . $channel->name); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
sub part_channel{ |
134
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
135
|
0
|
0
|
|
|
|
|
my $channel = ref($_[0]) eq "Mojo::IRC::Server::Chinese::Channel"?$_[0]:$s->search_channel(id=>$_[0]); |
136
|
0
|
|
|
|
|
|
my $part_info = $_[1]; |
137
|
0
|
0
|
|
|
|
|
return if not defined $channel; |
138
|
0
|
|
|
|
|
|
$channel->broadcast($s->ident,"PART",$channel->name,$part_info); |
139
|
0
|
|
|
|
|
|
for(my $i=0;$i<@{$s->channel};$i++){ |
|
0
|
|
|
|
|
|
|
140
|
0
|
0
|
|
|
|
|
if($channel->id eq $s->channel->[$i]){ |
141
|
0
|
|
|
|
|
|
splice @{$s->channel},$i,1; |
|
0
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
last; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
} |
145
|
0
|
|
|
|
|
|
$channel->remove_user($s->id); |
146
|
0
|
|
|
|
|
|
$s->info("[" . $s->nick . "] 离开频道 " . $channel->name); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
sub is_join_channel{ |
150
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
151
|
0
|
0
|
|
|
|
|
my $cid = ref($_[0]) eq "Mojo::IRC::Server::Chinese::Channel"?$_[0]->id:$_[0]; |
152
|
0
|
0
|
|
|
|
|
if(defined $cid){ |
153
|
0
|
0
|
|
0
|
|
|
return (first {$cid eq $_} @{$s->channel})?1:0; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
else{ |
156
|
0
|
|
|
|
|
|
return 0+@{$s->channel}; |
|
0
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
sub forward{ |
160
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
161
|
0
|
|
|
|
|
|
my %unique; |
162
|
0
|
|
|
|
|
|
for my $channel ($s->channels){ |
163
|
0
|
|
|
|
|
|
for my $user ($channel->users){ |
164
|
0
|
0
|
|
|
|
|
next if $user->id eq $s->id; |
165
|
0
|
0
|
|
|
|
|
next if exists $unique{$user->id}; |
166
|
0
|
|
|
|
|
|
$user->send(@_); |
167
|
0
|
|
|
|
|
|
$unique{$user->id} = 1; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub broadcast{ |
173
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
174
|
0
|
|
|
|
|
|
$s->send(@_); |
175
|
0
|
|
|
|
|
|
my %unique; |
176
|
0
|
|
|
|
|
|
for my $channel ($s->channels){ |
177
|
0
|
|
|
|
|
|
for my $user ($channel->users){ |
178
|
0
|
0
|
|
|
|
|
next if $user->id eq $s->id; |
179
|
0
|
0
|
|
|
|
|
next if exists $unique{$user->id}; |
180
|
0
|
|
|
|
|
|
$user->send(@_); |
181
|
0
|
|
|
|
|
|
$unique{$user->id} = 1; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
sub channels{ |
186
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
187
|
0
|
|
|
|
|
|
my @channels = (); |
188
|
0
|
|
|
|
|
|
for my $cid (@{$s->channel}){ |
|
0
|
|
|
|
|
|
|
189
|
0
|
|
|
|
|
|
my $channel = $s->search_channel(id=>$cid); |
190
|
0
|
0
|
|
|
|
|
push @channels ,$channel if defined $channel; |
191
|
|
|
|
|
|
|
} |
192
|
0
|
|
|
|
|
|
return @channels; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
sub each_channel{ |
195
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
196
|
0
|
|
|
|
|
|
my $callback = shift; |
197
|
0
|
0
|
|
|
|
|
return if not $s->is_join_channel(); |
198
|
0
|
|
|
|
|
|
for my $cid (@{$s->channel}){ |
|
0
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
|
my $channel = $s->search_channel(id=>$cid); |
200
|
0
|
0
|
|
|
|
|
$callback->($s,$channel,@_) if defined $channel; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub send{ |
205
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
206
|
0
|
0
|
|
|
|
|
return if $s->is_virtual ; |
207
|
0
|
|
|
|
|
|
my($prefix,$command,@params)=@_; |
208
|
0
|
|
|
|
|
|
my $msg = ""; |
209
|
0
|
0
|
|
|
|
|
$msg .= defined $prefix ? ":$prefix " : ""; |
210
|
0
|
|
|
|
|
|
$msg .= $command; |
211
|
0
|
|
|
|
|
|
my $trail; |
212
|
0
|
|
|
|
|
|
$trail = pop @params; |
213
|
0
|
|
|
|
|
|
$msg .= " $_" for @params; |
214
|
0
|
0
|
|
|
|
|
$msg .= defined $trail ? " :$trail" : ""; |
215
|
0
|
|
|
|
|
|
$msg .= "\r\n"; |
216
|
0
|
|
|
|
|
|
$s->io->write($msg); |
217
|
0
|
|
|
|
|
|
$s->debug("S[".$s->name."] $msg"); |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
sub is_localhost{ |
220
|
0
|
|
|
0
|
0
|
|
my $s = shift; |
221
|
0
|
0
|
|
|
|
|
return 0 if $s->is_virtual; |
222
|
0
|
0
|
|
|
|
|
return 1 if $s->io->handle->peerhost eq "127.0.0.1"; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
1; |