line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mojo::Webqq::Model; |
2
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
34
|
|
3
|
1
|
|
|
1
|
|
6
|
use List::Util qw(first); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
72
|
|
4
|
1
|
|
|
1
|
|
6
|
use base qw(Mojo::Webqq::Model::Base); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
493
|
|
5
|
1
|
|
|
1
|
|
408
|
use Mojo::Webqq::User; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
8
|
|
6
|
1
|
|
|
1
|
|
420
|
use Mojo::Webqq::Friend; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
8
|
|
7
|
1
|
|
|
1
|
|
442
|
use Mojo::Webqq::Group; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
8
|
|
8
|
1
|
|
|
1
|
|
492
|
use Mojo::Webqq::Discuss; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
9
|
|
9
|
1
|
|
|
1
|
|
7
|
use Mojo::Webqq::Discuss::Member; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
10
|
1
|
|
|
1
|
|
6
|
use Mojo::Webqq::Group::Member; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
6
|
|
11
|
1
|
|
|
1
|
|
451
|
use Mojo::Webqq::Model::Remote::_get_user_info; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
29
|
|
12
|
1
|
|
|
1
|
|
543
|
use Mojo::Webqq::Model::Remote::get_single_long_nick; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
33
|
|
13
|
1
|
|
|
1
|
|
2633
|
use Mojo::Webqq::Model::Remote::get_qq_from_id; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
32
|
|
14
|
1
|
|
|
1
|
|
1144
|
use Mojo::Webqq::Model::Remote::_get_user_friends; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
31
|
|
15
|
1
|
|
|
1
|
|
418
|
use Mojo::Webqq::Model::Remote::_get_user_friends_ext; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
16
|
1
|
|
|
1
|
|
644
|
use Mojo::Webqq::Model::Remote::_get_friends_state; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
17
|
1
|
|
|
1
|
|
413
|
use Mojo::Webqq::Model::Remote::_get_group_list_info; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
27
|
|
18
|
1
|
|
|
1
|
|
451
|
use Mojo::Webqq::Model::Remote::_get_group_list_info_ext; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
19
|
1
|
|
|
1
|
|
434
|
use Mojo::Webqq::Model::Remote::_get_group_info; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
20
|
1
|
|
|
1
|
|
432
|
use Mojo::Webqq::Model::Remote::_get_group_info_ext; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
21
|
1
|
|
|
1
|
|
973
|
use Mojo::Webqq::Model::Remote::_get_discuss_info; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
34
|
|
22
|
1
|
|
|
1
|
|
647
|
use Mojo::Webqq::Model::Remote::_get_discuss_list_info; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
33
|
|
23
|
1
|
|
|
1
|
|
779
|
use Mojo::Webqq::Model::Remote::_get_recent_info; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
34
|
|
24
|
1
|
|
|
1
|
|
412
|
use Mojo::Webqq::Model::Remote::_invite_friend; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
29
|
|
25
|
1
|
|
|
1
|
|
421
|
use Mojo::Webqq::Model::Remote::_set_group_admin; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
28
|
|
26
|
1
|
|
|
1
|
|
407
|
use Mojo::Webqq::Model::Remote::_remove_group_admin; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
28
|
|
27
|
1
|
|
|
1
|
|
427
|
use Mojo::Webqq::Model::Remote::_kick_group_member; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
28
|
|
28
|
1
|
|
|
1
|
|
444
|
use Mojo::Webqq::Model::Remote::_set_group_member_card; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
27
|
|
29
|
1
|
|
|
1
|
|
452
|
use Mojo::Webqq::Model::Remote::_shutup_group_member; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
28
|
|
30
|
1
|
|
|
1
|
|
532
|
use Mojo::Webqq::Model::Remote::_qiandao; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
28
|
|
31
|
1
|
|
|
1
|
|
5
|
use Encode (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
22
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub time33 { |
34
|
1
|
|
|
1
|
|
5
|
use integer; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
10
|
|
35
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
36
|
0
|
|
|
|
|
|
my $t = shift; |
37
|
0
|
|
|
|
|
|
my $e = 0; |
38
|
0
|
|
|
|
|
|
my $i = 0; |
39
|
0
|
|
|
|
|
|
for( my $n = length($t); $i<$n; $i++ ){ |
40
|
0
|
|
|
|
|
|
$e = ( 33 * $e + ord(substr($t,$i,1)) ) % 4294967296; |
41
|
|
|
|
|
|
|
} |
42
|
0
|
|
|
|
|
|
return $e; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
sub hash33{ |
45
|
1
|
|
|
1
|
|
86
|
use integer; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
4
|
|
46
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
47
|
0
|
|
|
|
|
|
my $t = shift; |
48
|
0
|
|
|
|
|
|
my $n = length($t); |
49
|
0
|
|
|
|
|
|
my $e = 0; |
50
|
0
|
|
|
|
|
|
for(my $i=0;$n>$i;$i++ ){ |
51
|
0
|
|
|
|
|
|
$e += ($e << 5) + ord(substr($t,$i,1)); |
52
|
|
|
|
|
|
|
} |
53
|
0
|
|
|
|
|
|
return 2147483647 & $e; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
sub hash { |
56
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
57
|
0
|
|
|
|
|
|
my $ptwebqq = shift; |
58
|
0
|
|
|
|
|
|
my $uin = shift; |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
$uin .= ""; |
61
|
0
|
|
|
|
|
|
my @ptb; |
62
|
0
|
|
|
|
|
|
for(my $i =0;$i
|
63
|
0
|
|
|
|
|
|
$ptb[$i % 4] ^= ord(substr($ptwebqq,$i,1)); |
64
|
|
|
|
|
|
|
} |
65
|
0
|
|
|
|
|
|
my @salt = ("EC", "OK"); |
66
|
0
|
|
|
|
|
|
my @uinByte; |
67
|
0
|
|
|
|
|
|
$uinByte[0] = $uin >> 24 & 0xFF ^ ord(substr($salt[0],0,1)); |
68
|
0
|
|
|
|
|
|
$uinByte[1] = $uin >> 16 & 0xFF ^ ord(substr($salt[0],1,1)); |
69
|
0
|
|
|
|
|
|
$uinByte[2] = $uin >> 8 & 0xFF ^ ord(substr($salt[1],0,1)); |
70
|
0
|
|
|
|
|
|
$uinByte[3] = $uin & 0xFF ^ ord(substr($salt[1],1,1)); |
71
|
0
|
|
|
|
|
|
my @result; |
72
|
0
|
|
|
|
|
|
for(my $i=0;$i<8;$i++){ |
73
|
0
|
0
|
|
|
|
|
$result[$i] = $i%2==0?$ptb[$i>>1]:$uinByte[$i>>1]; |
74
|
|
|
|
|
|
|
} |
75
|
0
|
|
|
|
|
|
my @hex = ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F"); |
76
|
0
|
|
|
|
|
|
my $buf = ""; |
77
|
0
|
|
|
|
|
|
for(my $i=0;$i<@result;$i++){ |
78
|
0
|
|
|
|
|
|
$buf .= $hex[$result[$i] >> 4 & 0xF]; |
79
|
0
|
|
|
|
|
|
$buf .= $hex[$result[$i] & 0xF]; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
return $buf; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub is_support_model_ext { |
86
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
87
|
0
|
|
|
|
|
|
return $self->model_ext; |
88
|
|
|
|
|
|
|
#return $self->uid && $self->pwd |
89
|
|
|
|
|
|
|
#my $ret = $self->search_cookie("p_skey") && $self->search_cookie("skey"); |
90
|
|
|
|
|
|
|
#$self->model_ext($ret || 0); |
91
|
|
|
|
|
|
|
#return $ret; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
sub get_model_status{ |
94
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
95
|
0
|
0
|
0
|
|
|
|
if( defined $self->model_status->{friend} |
96
|
|
|
|
|
|
|
and defined $self->model_status->{group} |
97
|
|
|
|
|
|
|
){ |
98
|
|
|
|
|
|
|
my $is_fail = |
99
|
|
|
|
|
|
|
$self->model_status->{friend} == 0 |
100
|
0
|
|
0
|
|
|
|
&& $self->model_status->{group} == 0 |
101
|
|
|
|
|
|
|
; |
102
|
0
|
0
|
|
|
|
|
return $is_fail?0:1; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
else{ |
105
|
0
|
|
|
|
|
|
return -1; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
sub get_csrf_token { |
109
|
1
|
|
|
1
|
|
494
|
use integer; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
12
|
|
110
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
111
|
0
|
0
|
|
|
|
|
if(not $self->is_support_model_ext){ |
112
|
0
|
|
|
|
|
|
$self->error("当前不支持获取扩展信息,无法获取CSRF Token"); |
113
|
0
|
|
|
|
|
|
return; |
114
|
|
|
|
|
|
|
} |
115
|
0
|
0
|
|
|
|
|
return $self->csrf_token if defined $self->csrf_token; |
116
|
0
|
|
|
|
|
|
my $t = $self->search_cookie("skey"); |
117
|
0
|
|
|
|
|
|
my $n = 0; |
118
|
0
|
|
|
|
|
|
my $o=length($t); |
119
|
0
|
|
|
|
|
|
my $r; |
120
|
0
|
0
|
|
|
|
|
if($t){ |
121
|
0
|
|
|
|
|
|
for($r=5381;$o>$n;$n++){ |
122
|
0
|
|
|
|
|
|
$r += ($r<<5) + ord(substr($t,$n,1)); |
123
|
|
|
|
|
|
|
} |
124
|
0
|
|
|
|
|
|
my $token = 2147483647 & $r; |
125
|
0
|
|
|
|
|
|
$self->csrf_token($token); |
126
|
0
|
|
|
|
|
|
return $token; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
sub each_friend{ |
130
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
131
|
0
|
|
|
|
|
|
my $callback = shift; |
132
|
0
|
0
|
|
|
|
|
$self->die("参数必须是函数引用") if ref $callback ne "CODE"; |
133
|
0
|
0
|
|
|
|
|
$self->update_friend(is_blocking=>1,is_update_friend_ext=>1) if @{$self->friend} == 0; |
|
0
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
for (@{$self->friend}){ |
|
0
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
|
$callback->($self,$_); |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
sub each_group{ |
139
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
140
|
0
|
|
|
|
|
|
my $callback = shift; |
141
|
0
|
0
|
|
|
|
|
$self->die("参数必须是函数引用") if ref $callback ne "CODE"; |
142
|
0
|
0
|
|
|
|
|
$self->update_group(is_blocking=>1,is_update_group_member=>0) if @{$self->group} == 0; |
|
0
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
for (@{$self->group}){ |
|
0
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
|
$callback->($self,$_); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub each_discuss{ |
149
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
150
|
0
|
|
|
|
|
|
my $callback = shift; |
151
|
0
|
0
|
|
|
|
|
$self->die("参数必须是函数引用") if ref $callback ne "CODE"; |
152
|
0
|
0
|
|
|
|
|
$self->update_discuss(is_blocking=>1,is_update_discuss_member=>0) if @{$self->discuss} == 0; |
|
0
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
|
for (@{$self->discuss}){ |
|
0
|
|
|
|
|
|
|
154
|
0
|
|
|
|
|
|
$callback->($self,$_); |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
sub each_group_member{ |
158
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
159
|
0
|
|
|
|
|
|
my $callback = shift; |
160
|
0
|
0
|
|
|
|
|
$self->die("参数必须是函数引用") if ref $callback ne "CODE"; |
161
|
0
|
0
|
|
|
|
|
if(@{$self->group} == 0){ |
|
0
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
|
$self->update_group(is_blocking=>1,is_update_group_member=>1); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
else{ |
165
|
0
|
|
|
|
|
|
for( @{$self->group}){ |
|
0
|
|
|
|
|
|
|
166
|
0
|
0
|
|
|
|
|
$_->update_group_member(is_blocking=>1,) if $_->is_empty; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
} |
169
|
0
|
|
|
|
|
|
my @member = map {@{$_->member}} grep {ref $_->member eq "ARRAY"} @{$self->group}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
|
for (@member){ |
171
|
0
|
|
|
|
|
|
$callback->($self,$_); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
sub each_discuss_member{ |
175
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
176
|
0
|
|
|
|
|
|
my $callback = shift; |
177
|
0
|
0
|
|
|
|
|
$self->die("参数必须是函数引用") if ref $callback ne "CODE"; |
178
|
0
|
0
|
|
|
|
|
if(@{$self->discuss} == 0){ |
|
0
|
|
|
|
|
|
|
179
|
0
|
|
|
|
|
|
$self->update_discuss(is_blocking=>1,is_update_discuss_member=>1); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
else{ |
182
|
0
|
|
|
|
|
|
for( @{$self->discuss}){ |
|
0
|
|
|
|
|
|
|
183
|
0
|
0
|
|
|
|
|
$_->update_discuss_member(is_blocking=>1,) if $_->is_empty; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
} |
186
|
0
|
|
|
|
|
|
my @member = map {@{$_->member}} grep {ref $_->member eq "ARRAY"} @{$self->discuss}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
|
for (@member){ |
188
|
0
|
|
|
|
|
|
$callback->($self,$_); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub update_user { |
193
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
194
|
0
|
|
|
|
|
|
my $is_blocking = ! shift; |
195
|
0
|
|
|
|
|
|
$self->info("更新个人信息...\n"); |
196
|
|
|
|
|
|
|
my $handle = sub{ |
197
|
0
|
|
|
0
|
|
|
my $user_info = shift; |
198
|
0
|
0
|
|
|
|
|
unless ( defined $user_info ) { |
199
|
0
|
|
|
|
|
|
$self->warn("更新个人信息失败\n"); |
200
|
0
|
|
|
|
|
|
$self->user(Mojo::Webqq::User->new({id=>$self->uid,uid=>$self->uid})); |
201
|
0
|
|
|
|
|
|
$self->emit("model_update"=>"user",0); |
202
|
0
|
|
|
|
|
|
return; |
203
|
|
|
|
|
|
|
} |
204
|
0
|
|
|
|
|
|
$self->user(Mojo::Webqq::User->new($user_info)); |
205
|
0
|
|
|
|
|
|
$self->emit("model_update"=>"user",1); |
206
|
0
|
|
|
|
|
|
}; |
207
|
0
|
0
|
|
|
|
|
if($is_blocking){ |
208
|
0
|
|
|
|
|
|
my $user_info = $self->_get_user_info(); |
209
|
0
|
|
|
|
|
|
$handle->($user_info); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
else{ |
212
|
0
|
|
|
|
|
|
$self->_get_user_info($handle); |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub remove_friend { |
217
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
218
|
0
|
|
|
|
|
|
my $friend = shift; |
219
|
0
|
0
|
|
|
|
|
$self->die("不支持的数据类型\n") if ref $friend ne "Mojo::Webqq::Friend"; |
220
|
0
|
|
|
|
|
|
for(my $i=0;@{$self->friend};$i++){ |
|
0
|
|
|
|
|
|
|
221
|
0
|
0
|
|
|
|
|
if($friend->id eq $self->friend->[$i]->id){ |
222
|
0
|
|
|
|
|
|
splice @{$self->friend},$i,1; |
|
0
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
|
return 1; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
} |
226
|
0
|
|
|
|
|
|
return 0; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
sub add_friend { |
229
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
230
|
0
|
|
|
|
|
|
my $friend = shift; |
231
|
0
|
|
|
|
|
|
my $nocheck = shift; |
232
|
0
|
0
|
|
|
|
|
$self->die("不支持的数据类型\n") if ref $friend ne "Mojo::Webqq::Friend"; |
233
|
0
|
0
|
|
|
|
|
if(@{$self->friend} == 0){ |
|
0
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
push @{$self->friend},$friend; |
|
0
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
|
return $self; |
236
|
|
|
|
|
|
|
} |
237
|
0
|
0
|
|
|
|
|
if($nocheck){ |
238
|
0
|
|
|
|
|
|
push @{$self->friend},$friend; |
|
0
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
|
return $self; |
240
|
|
|
|
|
|
|
} |
241
|
0
|
|
|
|
|
|
my $f = $self->search_friend(id => $friend->id); |
242
|
0
|
0
|
|
|
|
|
if(defined $f){ |
243
|
0
|
|
|
|
|
|
%$f = %$friend; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
else{ |
246
|
0
|
|
|
|
|
|
push @{$self->friend},$friend; |
|
0
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
} |
248
|
0
|
|
|
|
|
|
return $self; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub update_friend_ext { |
252
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
253
|
0
|
|
|
|
|
|
my %p = @_; |
254
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking} ; |
255
|
0
|
0
|
|
|
|
|
if ( not $self->is_support_model_ext){ |
256
|
0
|
|
|
|
|
|
$self->warn("无法支持获取扩展信息"); |
257
|
0
|
|
|
|
|
|
return; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
my $handle = sub{ |
260
|
0
|
|
|
0
|
|
|
my $friends_ext_info = shift; |
261
|
0
|
0
|
0
|
|
|
|
if(defined $friends_ext_info and ref $friends_ext_info eq "ARRAY"){ |
262
|
0
|
|
|
|
|
|
$self->info("更新好友扩展信息..."); |
263
|
0
|
|
|
|
|
|
my(undef,$ext)=$self->array_unique($friends_ext_info,sub{$_[0]->{displayname} . "|" . $_[0]->{category}},"friend_ext"); |
|
0
|
|
|
|
|
|
|
264
|
0
|
|
|
|
|
|
my $unique_friend = $self->array_unique($self->friend,sub{$_[0]->displayname . "|" . $_[0]->category},"friend"); |
|
0
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
for my $f(@$unique_friend){ |
266
|
0
|
|
|
|
|
|
my $id = $f->displayname . "|" . $f->category; |
267
|
0
|
0
|
|
|
|
|
next if not exists $ext->{$id}; |
268
|
0
|
|
|
|
|
|
$f->{uid} = $ext->{$id}{uid}; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
0
|
0
|
|
|
|
|
if($self->log_level eq 'debug'){ |
272
|
0
|
|
|
|
|
|
for(@{$self->friend}){ |
|
0
|
|
|
|
|
|
|
273
|
0
|
0
|
|
|
|
|
$self->debug("更新好友[" . $_->displayname . "|" . $_->category . "]扩展信息uid失败") if not $_->uid; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
0
|
|
|
|
|
|
$self->emit("model_update"=>"friend_ext",1); |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
else{ |
280
|
0
|
|
|
|
|
|
$self->warn("更新好友扩展信息失败"); |
281
|
0
|
|
|
|
|
|
$self->emit("model_update"=>"friend_ext",0); |
282
|
|
|
|
|
|
|
} |
283
|
0
|
|
|
|
|
|
}; |
284
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
285
|
0
|
|
|
|
|
|
my $friends_ext_info = $self->_get_user_friends_ext(); |
286
|
0
|
|
|
|
|
|
$handle->($friends_ext_info); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
else{ |
289
|
0
|
|
|
|
|
|
$self->_get_user_friends_ext($handle); |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
sub update_friend { |
293
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
294
|
0
|
0
|
|
|
|
|
if(ref $_[0] eq "Mojo::Webqq::Friend"){ |
295
|
0
|
|
|
|
|
|
my $friend = shift; |
296
|
0
|
|
|
|
|
|
my %p = @_; |
297
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking}; |
298
|
0
|
|
|
|
|
|
$self->info("更新好友 [ " . $friend->displayname . " ] 信息..."); |
299
|
|
|
|
|
|
|
my $handle = sub{ |
300
|
0
|
|
|
0
|
|
|
my $friend_info = shift; |
301
|
0
|
0
|
|
|
|
|
if(defined $friend_info){$friend->update($friend_info);} |
|
0
|
|
|
|
|
|
|
302
|
0
|
|
|
|
|
|
else{$self->warn("更新好友 [ " . $friend->displayname . " ] 信息失败...");} |
303
|
0
|
|
|
|
|
|
}; |
304
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
305
|
0
|
|
|
|
|
|
my $friend_info = $self->_get_friend_info($friend->id); |
306
|
0
|
|
|
|
|
|
$handle->($friend_info); |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
else{ |
309
|
0
|
|
|
|
|
|
$self->_get_friend_info($friend->id,$handle); |
310
|
|
|
|
|
|
|
} |
311
|
0
|
|
|
|
|
|
return $self; |
312
|
|
|
|
|
|
|
} |
313
|
0
|
|
|
|
|
|
my %p = @_; |
314
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking}; |
315
|
0
|
0
|
|
|
|
|
$p{is_update_friend_ext} = 1 if not defined $p{is_update_friend_ext}; |
316
|
|
|
|
|
|
|
my $handle = sub{ |
317
|
0
|
|
|
0
|
|
|
my @friends; |
318
|
0
|
|
|
|
|
|
my $friends_info = shift; |
319
|
0
|
0
|
|
|
|
|
if(defined $friends_info){ |
320
|
0
|
|
|
|
|
|
$self->info("更新好友信息..."); |
321
|
0
|
|
|
|
|
|
push @friends,Mojo::Webqq::Friend->new($_) for @{$friends_info}; |
|
0
|
|
|
|
|
|
|
322
|
0
|
0
|
0
|
|
|
|
if(ref $self->friend eq "ARRAY" and @{$self->friend} == 0){ |
|
0
|
|
|
|
|
|
|
323
|
0
|
|
|
|
|
|
$self->friend(\@friends); |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
else{ |
326
|
0
|
|
|
|
|
|
my($new_friends,$lost_friends,$sames) = $self->array_diff($self->friend,\@friends,sub{$_[0]->id}); |
|
0
|
|
|
|
|
|
|
327
|
0
|
|
|
|
|
|
for(@{$new_friends}){ |
|
0
|
|
|
|
|
|
|
328
|
0
|
|
|
|
|
|
$self->add_friend($_); |
329
|
0
|
|
|
|
|
|
$self->emit(new_friend=>$_); |
330
|
|
|
|
|
|
|
} |
331
|
0
|
|
|
|
|
|
for(@{$lost_friends}){ |
|
0
|
|
|
|
|
|
|
332
|
0
|
|
|
|
|
|
$self->remove_friend($_); |
333
|
0
|
|
|
|
|
|
$self->emit(lose_friend=>$_); |
334
|
|
|
|
|
|
|
} |
335
|
0
|
|
|
|
|
|
for(@{$sames}){ |
|
0
|
|
|
|
|
|
|
336
|
0
|
|
|
|
|
|
my($old,$new) = @$_; |
337
|
0
|
|
|
|
|
|
$old->update($new); |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
} |
340
|
0
|
|
|
|
|
|
$self->emit("model_update","friend",1); |
341
|
0
|
0
|
|
|
|
|
$self->update_friend_ext(is_blocking=>$p{is_blocking}) if $p{is_update_friend_ext}; |
342
|
|
|
|
|
|
|
} |
343
|
0
|
|
|
|
|
|
else{$self->warn("更新好友信息失败");$self->emit("model_update","friend",0);} |
|
0
|
|
|
|
|
|
|
344
|
0
|
|
|
|
|
|
}; |
345
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
346
|
0
|
|
|
|
|
|
my $friends_info = $self->_get_user_friends(); |
347
|
0
|
|
|
|
|
|
$handle->($friends_info); |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
else{ |
350
|
0
|
|
|
|
|
|
$self->_get_user_friends($handle); |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
sub search_friend { |
354
|
1
|
|
|
1
|
|
2281
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
2741
|
|
355
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
356
|
0
|
|
|
|
|
|
my %p = @_; |
357
|
0
|
0
|
|
|
|
|
return if 0 == grep {defined $p{$_}} keys %p; |
|
0
|
|
|
|
|
|
|
358
|
0
|
0
|
|
|
|
|
$self->update_friend(is_blocking=>1,is_update_friend_ext=>1) if @{ $self->friend } == 0; |
|
0
|
|
|
|
|
|
|
359
|
0
|
0
|
|
|
|
|
if(wantarray){ |
360
|
0
|
0
|
|
0
|
|
|
return grep {my $f = $_;(first {$p{$_} ne $f->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->friend}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
else{ |
363
|
0
|
0
|
|
0
|
|
|
return first {my $f = $_;(first {$p{$_} ne $f->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->friend}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
sub add_group{ |
368
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
369
|
0
|
|
|
|
|
|
my $group = shift; |
370
|
0
|
|
|
|
|
|
my $nocheck = shift; |
371
|
0
|
0
|
|
|
|
|
$self->die("不支持的数据类型") if ref $group ne "Mojo::Webqq::Group"; |
372
|
0
|
0
|
|
|
|
|
if(@{$self->group} == 0){ |
|
0
|
|
|
|
|
|
|
373
|
0
|
|
|
|
|
|
push @{$self->group},$group; |
|
0
|
|
|
|
|
|
|
374
|
0
|
|
|
|
|
|
return $self; |
375
|
|
|
|
|
|
|
} |
376
|
0
|
0
|
|
|
|
|
if($nocheck){ |
377
|
0
|
|
|
|
|
|
push @{$self->group},$group; |
|
0
|
|
|
|
|
|
|
378
|
0
|
|
|
|
|
|
return $self; |
379
|
|
|
|
|
|
|
} |
380
|
0
|
|
|
|
|
|
my $g = $self->search_group(id => $group->id); |
381
|
0
|
0
|
|
|
|
|
if(defined $g){ |
382
|
0
|
|
|
|
|
|
%$g = %$group; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
else{#new group |
385
|
0
|
|
|
|
|
|
push @{$self->group},$group; |
|
0
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
} |
387
|
0
|
|
|
|
|
|
return $self; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
sub remove_group{ |
390
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
391
|
0
|
|
|
|
|
|
my $group = shift; |
392
|
0
|
0
|
|
|
|
|
$self->die("不支持的数据类型") if ref $group ne "Mojo::Webqq::Group"; |
393
|
0
|
|
|
|
|
|
for(my $i=0;@{$self->group};$i++){ |
|
0
|
|
|
|
|
|
|
394
|
0
|
0
|
|
|
|
|
if($group->id eq $self->group->[$i]->id){ |
395
|
0
|
|
|
|
|
|
splice @{$self->group},$i,1; |
|
0
|
|
|
|
|
|
|
396
|
0
|
|
|
|
|
|
return 1; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
} |
399
|
0
|
|
|
|
|
|
return 0; |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
sub update_group_ext { |
402
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
403
|
0
|
0
|
|
|
|
|
if ( not $self->is_support_model_ext){ |
404
|
0
|
|
|
|
|
|
$self->warn("无法支持获取扩展信息"); |
405
|
0
|
|
|
|
|
|
return; |
406
|
|
|
|
|
|
|
} |
407
|
0
|
0
|
|
|
|
|
return if @{ $self->group } == 0; |
|
0
|
|
|
|
|
|
|
408
|
0
|
|
|
|
|
|
my $group; |
409
|
0
|
0
|
|
|
|
|
$group = shift if ref $_[0] eq "Mojo::Webqq::Group"; |
410
|
0
|
|
|
|
|
|
my %p = @_; |
411
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking}; |
412
|
0
|
0
|
|
|
|
|
$p{is_update_group_member_ext} = 1 if not defined $p{is_update_group_member_ext}; |
413
|
|
|
|
|
|
|
|
414
|
0
|
0
|
0
|
|
|
|
if(defined $group and defined $group->uid){#要更新的指定群组已经包含扩展信息 |
|
|
0
|
0
|
|
|
|
|
415
|
0
|
0
|
|
|
|
|
$self->update_group_member_ext($group,%p) if $p{is_update_group_member_ext}; |
416
|
0
|
|
|
|
|
|
return; |
417
|
|
|
|
|
|
|
} |
418
|
0
|
|
|
0
|
|
|
elsif( (!defined $group) and (! first { !defined $_->uid} @{$self->group} ) ){ #所有群组都包含扩展信息了 |
419
|
0
|
|
|
|
|
|
for(@{$self->group}){ |
|
0
|
|
|
|
|
|
|
420
|
0
|
0
|
|
|
|
|
$self->update_group_member_ext($_,%p) if $p{is_update_group_member_ext}; |
421
|
|
|
|
|
|
|
} |
422
|
0
|
|
|
|
|
|
return; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
my $handle = sub{ |
425
|
0
|
|
|
0
|
|
|
my $group_list_ext = shift; |
426
|
0
|
0
|
0
|
|
|
|
if(defined $group_list_ext and ref $group_list_ext eq "ARRAY"){ |
427
|
0
|
|
|
|
|
|
$self->info("更新群列表扩展信息..."); |
428
|
0
|
|
|
|
|
|
my(undef,$gext)= $self->array_unique($group_list_ext,sub{$_[0]->{name}},"group_ext"); |
|
0
|
|
|
|
|
|
|
429
|
0
|
|
|
|
|
|
my $unique_group = $self->array_unique($self->group,sub{$_[0]->name},"group"); |
|
0
|
|
|
|
|
|
|
430
|
0
|
0
|
|
|
|
|
my @groups = defined $group?(grep {$_->id eq $group->id} @$unique_group) : @$unique_group; |
|
0
|
|
|
|
|
|
|
431
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
432
|
0
|
|
|
|
|
|
for my $g (@groups){ |
433
|
0
|
|
|
|
|
|
my $id = $g->name; |
434
|
0
|
0
|
|
|
|
|
next if not exists $gext->{$id}; |
435
|
0
|
|
|
|
|
|
$g->update($gext->{$id}); |
436
|
0
|
0
|
|
|
|
|
$self->update_group_member_ext($g,%p) if $p{is_update_group_member_ext}; |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
else{ |
440
|
0
|
|
|
|
|
|
my $i = -3; |
441
|
0
|
|
|
|
|
|
for my $g (@groups){ |
442
|
0
|
|
|
|
|
|
my $id = $g->name; |
443
|
0
|
0
|
|
|
|
|
next if not exists $gext->{$id}; |
444
|
0
|
|
|
|
|
|
$g->update($gext->{$id}); |
445
|
|
|
|
|
|
|
$self->timer($i+3,sub{ |
446
|
0
|
0
|
|
|
|
|
$self->update_group_member_ext($g,%p) if $p{is_update_group_member_ext}; |
447
|
0
|
|
|
|
|
|
}); |
448
|
0
|
|
|
|
|
|
$i++; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
} |
451
|
0
|
|
|
|
|
|
$self->emit("model_update","group_ext",1); |
452
|
|
|
|
|
|
|
} |
453
|
0
|
|
|
|
|
|
else{$self->warn("更新群扩展信息失败");$self->emit("model_update","group_ext",0);} |
|
0
|
|
|
|
|
|
|
454
|
0
|
|
|
|
|
|
}; |
455
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
456
|
0
|
|
|
|
|
|
my $group_list_ext = $self->_get_group_list_info_ext(); |
457
|
0
|
|
|
|
|
|
$handle->($group_list_ext); |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
else{ |
460
|
0
|
|
|
|
|
|
$self->_get_group_list_info_ext($handle); |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
sub update_group_member_ext { |
464
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
465
|
0
|
|
|
|
|
|
my $group = shift; |
466
|
0
|
0
|
|
|
|
|
if ( not $self->is_support_model_ext){ |
467
|
0
|
|
|
|
|
|
$self->warn("群组[ ". $group->name . " ]当前无法支持获取扩展信息"); |
468
|
0
|
|
|
|
|
|
return; |
469
|
|
|
|
|
|
|
} |
470
|
0
|
0
|
|
|
|
|
$self->die("不支持的数据类型") if ref $group ne "Mojo::Webqq::Group"; |
471
|
0
|
0
|
|
|
|
|
if(not defined $group->uid){ |
472
|
0
|
|
|
|
|
|
$self->warn("群组[ ". $group->name . " ]未包含有效的uid,无法更新群成员扩展信息"); |
473
|
0
|
|
|
|
|
|
return; |
474
|
|
|
|
|
|
|
} |
475
|
0
|
0
|
|
|
|
|
if($group->is_empty){ |
476
|
0
|
|
|
|
|
|
$self->warn("群组[ ". $group->name . " ]未包含群成员,忽略更新群成员扩展信息"); |
477
|
0
|
|
|
|
|
|
return; |
478
|
|
|
|
|
|
|
} |
479
|
0
|
|
|
|
|
|
my %p = @_; |
480
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking}; |
481
|
|
|
|
|
|
|
my $handle = sub{ |
482
|
0
|
|
|
0
|
|
|
my $group_info_ext = shift; |
483
|
0
|
0
|
|
|
|
|
if(defined $group_info_ext){ |
484
|
0
|
|
|
|
|
|
$self->info("更新群组[ ". $group->name . " ]成员扩展信息"); |
485
|
|
|
|
|
|
|
my $unique_sub = sub{ |
486
|
0
|
|
0
|
|
|
|
my $name = $_[0]->{name} // ""; |
487
|
0
|
|
0
|
|
|
|
my $card = $_[0]->{card} // ""; |
488
|
0
|
0
|
|
|
|
|
if(ref $self->group_member_identify_callback eq 'CODE'){ |
489
|
0
|
|
|
|
|
|
return $self->group_member_identify_callback->($name,$card); |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
else{ |
492
|
0
|
0
|
|
|
|
|
return $self->group_member_card_ext_only? $name: $name . $card; |
493
|
|
|
|
|
|
|
} |
494
|
0
|
|
|
|
|
|
}; |
495
|
0
|
|
|
|
|
|
my(undef,$mext) = $self->array_unique($group_info_ext->{member},$unique_sub,$group->name . " member_ext"); |
496
|
0
|
|
|
|
|
|
my $unique_member = $self->array_unique($group->member,$unique_sub,$group->name . " member"); |
497
|
0
|
|
|
|
|
|
for(@$unique_member){ |
498
|
0
|
|
|
|
|
|
my $id = $unique_sub->($_); |
499
|
0
|
0
|
|
|
|
|
next if not exists $mext->{$id}; |
500
|
0
|
|
|
|
|
|
$_->update($mext->{$id}); |
501
|
|
|
|
|
|
|
} |
502
|
0
|
0
|
|
|
|
|
if($self->log_level eq 'debug'){ |
503
|
0
|
|
|
|
|
|
for(@{$group->member}){ |
|
0
|
|
|
|
|
|
|
504
|
0
|
0
|
|
|
|
|
$self->debug("更新群成员[".$_->name . "|" . $group->name ."]扩展信息uid失败") if not $_->uid; |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
} |
507
|
0
|
|
0
|
|
|
|
$group->{max_member} //= $group_info_ext->{max_member}; |
508
|
0
|
|
0
|
|
|
|
$group->{max_admin} //= $group_info_ext->{max_admin}; |
509
|
0
|
|
|
|
|
|
$group->{_is_hold_member_ext} = 1; |
510
|
0
|
|
|
|
|
|
$self->emit("model_update","group_member_ext",1); |
511
|
|
|
|
|
|
|
} |
512
|
0
|
|
|
|
|
|
else{$self->warn("更新群组[ " . $group->name . " ]成员扩展信息失败");} |
513
|
0
|
|
|
|
|
|
}; |
514
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
515
|
0
|
|
|
|
|
|
my $group_info_ext = $self->_get_group_info_ext($group->uid); |
516
|
0
|
|
|
|
|
|
$handle->($group_info_ext); |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
else{ |
519
|
0
|
|
|
|
|
|
$self->_get_group_info_ext($group->uid,$handle); |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
sub update_group_member { |
524
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
525
|
0
|
|
|
|
|
|
my $group = shift; |
526
|
0
|
0
|
|
|
|
|
$self->die("不支持的数据类型") if ref $group ne "Mojo::Webqq::Group"; |
527
|
0
|
|
|
|
|
|
my %p = @_; |
528
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking}; |
529
|
0
|
0
|
|
|
|
|
$p{is_update_group_member_ext} = 1 if not defined $p{is_update_group_member_ext}; |
530
|
|
|
|
|
|
|
my $handle = sub{ |
531
|
0
|
|
|
0
|
|
|
my $group_info = shift; |
532
|
0
|
0
|
|
|
|
|
if(defined $group_info){ |
533
|
0
|
|
|
|
|
|
$self->info("更新群组[ ". $group->name . " ]成员信息"); |
534
|
0
|
0
|
|
|
|
|
if(ref $group_info->{member} eq 'ARRAY'){ |
535
|
0
|
|
|
|
|
|
$group->update($group_info); |
536
|
0
|
0
|
|
|
|
|
$self->update_group_member_ext($group,%p) if $p{is_update_group_member_ext}; |
537
|
|
|
|
|
|
|
} |
538
|
0
|
|
|
|
|
|
else{$self->debug("更新群组[ " . $group->name . " ]成员信息无效")} |
539
|
|
|
|
|
|
|
} |
540
|
0
|
|
|
|
|
|
else{$self->warn("更新群组[ " . $group->name . " ]成员信息失败")} |
541
|
|
|
|
|
|
|
|
542
|
0
|
|
|
|
|
|
}; |
543
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
544
|
0
|
|
|
|
|
|
my $group_info = $self->_get_group_info($group->code); |
545
|
0
|
|
|
|
|
|
$handle->($group_info); |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
else{ |
548
|
0
|
|
|
|
|
|
$self->_get_group_info($group->code,$handle); |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
sub update_group { |
552
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
553
|
0
|
0
|
|
|
|
|
if(ref $_[0] eq "Mojo::Webqq::Group"){ |
554
|
0
|
|
|
|
|
|
my $group = shift; |
555
|
0
|
|
|
|
|
|
my %p = @_; |
556
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking}; |
557
|
0
|
0
|
|
|
|
|
$p{is_update_group_member} = 1 if not defined $p{is_update_group_member} ; |
558
|
0
|
0
|
|
|
|
|
$p{is_update_group_ext} = $p{is_blocking} if not defined $p{is_update_group_ext} ; |
559
|
0
|
0
|
0
|
|
|
|
$p{is_update_group_member_ext} = $p{is_update_group_ext} && $p{is_blocking} if not defined $p{is_update_group_member_ext} ; |
560
|
|
|
|
|
|
|
my $handle = sub{ |
561
|
0
|
|
|
0
|
|
|
my $group_info = shift; |
562
|
0
|
0
|
|
|
|
|
if(defined $group_info){ |
563
|
0
|
0
|
|
|
|
|
if(ref $group_info->{member} eq 'ARRAY'){ |
564
|
0
|
|
|
|
|
|
$self->info("更新群组[ ". $group->name . " ]信息"); |
565
|
0
|
|
|
|
|
|
$group->update($group_info); |
566
|
0
|
0
|
|
|
|
|
$self->update_group_ext($group,%p) if $p{is_update_group_ext}; |
567
|
|
|
|
|
|
|
} |
568
|
0
|
|
|
|
|
|
else{$self->debug("更新群组[ " . $group->name . " ]成员信息无效")} |
569
|
|
|
|
|
|
|
} |
570
|
0
|
|
|
|
|
|
else{$self->warn("更新群组[ " . $group->name . " ]成员信息失败")} |
571
|
|
|
|
|
|
|
|
572
|
0
|
|
|
|
|
|
}; |
573
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
574
|
0
|
|
|
|
|
|
my $group_info = $self->_get_group_info($group->code); |
575
|
0
|
|
|
|
|
|
$handle->($group_info); |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
else{ |
578
|
0
|
|
|
|
|
|
$self->_get_group_info($group->code,$handle); |
579
|
|
|
|
|
|
|
} |
580
|
0
|
|
|
|
|
|
return $self; |
581
|
|
|
|
|
|
|
} |
582
|
0
|
|
|
|
|
|
my %p = @_; |
583
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking} ; |
584
|
0
|
0
|
|
|
|
|
$p{is_update_group_member} = 1 if not defined $p{is_update_group_member} ; |
585
|
0
|
0
|
|
|
|
|
$p{is_update_group_ext} = $p{is_blocking} if not defined $p{is_update_group_ext} ; |
586
|
0
|
0
|
0
|
|
|
|
$p{is_update_group_member_ext} = $p{is_blocking} && $p{is_update_group_ext} && $p{is_update_group_member} if not defined $p{is_update_group_member_ext} ; |
587
|
|
|
|
|
|
|
my $handle = sub{ |
588
|
0
|
|
|
0
|
|
|
my @groups; |
589
|
0
|
|
|
|
|
|
my $group_list = shift; |
590
|
0
|
0
|
|
|
|
|
unless(defined $group_list){ |
591
|
0
|
|
|
|
|
|
$self->warn("更新群列表信息失败\n"); |
592
|
0
|
|
|
|
|
|
$self->emit("model_update","group",0); |
593
|
0
|
|
|
|
|
|
return $self; |
594
|
|
|
|
|
|
|
} |
595
|
0
|
|
|
|
|
|
$self->info("更新群列表信息..."); |
596
|
0
|
|
|
|
|
|
for my $g (@{$group_list}){ |
|
0
|
|
|
|
|
|
|
597
|
0
|
|
|
|
|
|
push @groups, Mojo::Webqq::Group->new($g); |
598
|
|
|
|
|
|
|
} |
599
|
0
|
0
|
0
|
|
|
|
if(ref $self->group eq "ARRAY" and @{$self->group} == 0){ |
|
0
|
|
|
|
|
|
|
600
|
0
|
|
|
|
|
|
$self->group(\@groups); |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
else{ |
603
|
0
|
|
|
|
|
|
my($new_groups,$lost_groups,$sames) = $self->array_diff($self->group,\@groups,sub{$_[0]->id}); |
|
0
|
|
|
|
|
|
|
604
|
0
|
|
|
|
|
|
for(@{$new_groups}){ |
|
0
|
|
|
|
|
|
|
605
|
0
|
|
|
|
|
|
$self->add_group($_); |
606
|
0
|
|
|
|
|
|
$self->emit(new_group=>$_) ; |
607
|
|
|
|
|
|
|
} |
608
|
0
|
|
|
|
|
|
for(@{$lost_groups}){ |
|
0
|
|
|
|
|
|
|
609
|
0
|
|
|
|
|
|
$self->remove_group($_); |
610
|
0
|
|
|
|
|
|
$self->emit(lose_group=>$_) ; |
611
|
|
|
|
|
|
|
} |
612
|
0
|
|
|
|
|
|
for(@{$sames}){ |
|
0
|
|
|
|
|
|
|
613
|
0
|
|
|
|
|
|
my($old_group,$new_group) = ($_->[0],$_->[1]); |
614
|
0
|
|
|
|
|
|
$old_group->update($new_group); |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
} |
617
|
0
|
|
|
|
|
|
$self->emit("model_update","group",1); |
618
|
0
|
0
|
|
|
|
|
if($p{is_update_group_member}){ |
619
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
620
|
0
|
|
|
|
|
|
for(@{ $self->group }){ |
|
0
|
|
|
|
|
|
|
621
|
0
|
|
|
|
|
|
$self->update_group_member($_,%p); |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
else{ |
625
|
0
|
|
|
|
|
|
my $i = -3; |
626
|
0
|
|
|
|
|
|
for my $g (@{ $self->group }){ |
|
0
|
|
|
|
|
|
|
627
|
0
|
|
|
|
|
|
$self->timer($i+3,sub{$self->update_group_member($g,%p)}); |
|
0
|
|
|
|
|
|
|
628
|
0
|
|
|
|
|
|
$i++; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
} |
632
|
0
|
0
|
|
|
|
|
if($p{is_update_group_ext}){ |
633
|
0
|
|
|
|
|
|
$self->update_group_ext(%p); |
634
|
|
|
|
|
|
|
} |
635
|
0
|
|
|
|
|
|
}; |
636
|
|
|
|
|
|
|
|
637
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
638
|
0
|
|
|
|
|
|
my $group_list = $self->_get_group_list_info(); |
639
|
0
|
|
|
|
|
|
$handle->($group_list); |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
else{ |
642
|
0
|
|
|
|
|
|
$self->_get_group_list_info($handle); |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
sub search_group { |
647
|
1
|
|
|
1
|
|
10
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
306
|
|
648
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
649
|
0
|
|
|
|
|
|
my %p = @_; |
650
|
0
|
0
|
|
|
|
|
return if 0 == grep {defined $p{$_}} keys %p; |
|
0
|
|
|
|
|
|
|
651
|
0
|
0
|
|
|
|
|
$self->update_group(is_update_group_member=>0) if @{ $self->group } == 0; |
|
0
|
|
|
|
|
|
|
652
|
0
|
|
|
|
|
|
delete $p{member}; |
653
|
0
|
0
|
|
|
|
|
if(wantarray){ |
654
|
0
|
0
|
|
0
|
|
|
return grep {my $g = $_;(first {$p{$_} ne $g->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->group}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
else{ |
657
|
0
|
0
|
|
0
|
|
|
return first {my $g = $_;(first {$p{$_} ne $g->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->group}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
} |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
sub search_group_member { |
662
|
1
|
|
|
1
|
|
8
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
1522
|
|
663
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
664
|
0
|
|
|
|
|
|
my %p = @_; |
665
|
0
|
0
|
|
|
|
|
return if 0 == grep {defined $p{$_}} keys %p; |
|
0
|
|
|
|
|
|
|
666
|
0
|
0
|
|
|
|
|
if(@{$self->group} == 0){ |
|
0
|
|
|
|
|
|
|
667
|
0
|
|
|
|
|
|
$self->update_group(is_blocking=>1,is_update_group_member=>1); |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
else{ |
670
|
0
|
|
|
|
|
|
for( @{$self->group}){ |
|
0
|
|
|
|
|
|
|
671
|
0
|
0
|
|
|
|
|
$_->update_group_member(is_blocking=>1,) if $_->is_empty; |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
} |
674
|
0
|
|
|
|
|
|
my @member = map {@{$_->member}} grep {ref $_->member eq "ARRAY"} @{$self->group}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
675
|
0
|
0
|
|
|
|
|
if(wantarray){ |
676
|
0
|
0
|
|
0
|
|
|
return grep {my $m = $_;(first {$p{$_} ne $m->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @member; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
else{ |
679
|
0
|
0
|
|
0
|
|
|
return first {my $m = $_;(first {$p{$_} ne $m->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @member; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
sub add_discuss { |
684
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
685
|
0
|
|
|
|
|
|
my $discuss = shift; |
686
|
0
|
|
|
|
|
|
my $nocheck = shift; |
687
|
0
|
0
|
|
|
|
|
$self->die("不支持的数据类型") if ref $discuss ne "Mojo::Webqq::Discuss"; |
688
|
0
|
0
|
|
|
|
|
if(@{$self->discuss} == 0){ |
|
0
|
|
|
|
|
|
|
689
|
0
|
|
|
|
|
|
push @{$self->discuss},$discuss; |
|
0
|
|
|
|
|
|
|
690
|
0
|
|
|
|
|
|
return $self; |
691
|
|
|
|
|
|
|
} |
692
|
0
|
0
|
|
|
|
|
if($nocheck){ |
693
|
0
|
|
|
|
|
|
push @{$self->discuss},$discuss; |
|
0
|
|
|
|
|
|
|
694
|
0
|
|
|
|
|
|
return $self; |
695
|
|
|
|
|
|
|
} |
696
|
0
|
|
|
|
|
|
my $d = $self->search_discuss(id => $discuss->id); |
697
|
0
|
0
|
|
|
|
|
if(defined $d){ |
698
|
0
|
|
|
|
|
|
%$d = %$discuss; |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
else{#new discuss |
701
|
0
|
|
|
|
|
|
push @{$self->discuss},$discuss; |
|
0
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
} |
703
|
0
|
|
|
|
|
|
return $self; |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
sub remove_discuss { |
707
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
708
|
0
|
|
|
|
|
|
my $discuss = shift; |
709
|
0
|
0
|
|
|
|
|
$self->die("不支持的数据类型") if ref $discuss ne "Mojo::Webqq::Discuss"; |
710
|
0
|
|
|
|
|
|
for(my $i=0;@{$self->discuss};$i++){ |
|
0
|
|
|
|
|
|
|
711
|
0
|
0
|
|
|
|
|
if($discuss->id eq $self->discuss->[$i]->id){ |
712
|
0
|
|
|
|
|
|
splice @{$self->discuss},$i,1; |
|
0
|
|
|
|
|
|
|
713
|
0
|
|
|
|
|
|
return 1; |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
} |
716
|
0
|
|
|
|
|
|
return 0; |
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
0
|
0
|
|
sub add_discuss_member {} |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
sub update_discuss_member{ |
722
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
723
|
0
|
|
|
|
|
|
my $discuss = shift; |
724
|
0
|
0
|
|
|
|
|
$self->die("不支持的数据类型") if ref $discuss ne "Mojo::Webqq::Discuss"; |
725
|
0
|
|
|
|
|
|
$self->info("更新讨论组[ ". $discuss->name . " ]成员信息"); |
726
|
0
|
|
|
|
|
|
my %p = @_; |
727
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking}; |
728
|
|
|
|
|
|
|
my $handle = sub{ |
729
|
0
|
|
|
0
|
|
|
my $discuss_info = shift; |
730
|
0
|
0
|
|
|
|
|
if(defined $discuss_info){ |
731
|
0
|
0
|
|
|
|
|
if(ref $discuss_info->{member} eq 'ARRAY'){ |
732
|
0
|
|
|
|
|
|
$discuss->update($discuss_info); |
733
|
|
|
|
|
|
|
} |
734
|
0
|
|
|
|
|
|
else{$self->debug("更新讨论组[ " . $discuss->name . " ]成员信息无效")} |
735
|
|
|
|
|
|
|
} |
736
|
0
|
|
|
|
|
|
else{$self->warn("更新讨论组[ " . $discuss->name . " ]成员信息失败")} |
737
|
0
|
|
|
|
|
|
}; |
738
|
|
|
|
|
|
|
|
739
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
740
|
0
|
|
|
|
|
|
my $discuss_info = $self->_get_discuss_info($discuss->id); |
741
|
0
|
|
|
|
|
|
$handle->($discuss_info); |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
else{ |
744
|
0
|
|
|
|
|
|
$self->_get_discuss_info($discuss->id,$handle); |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
sub update_discuss { |
749
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
750
|
0
|
0
|
|
|
|
|
if(ref $_[0] eq "Mojo::Webqq::Discuss"){ |
751
|
0
|
|
|
|
|
|
my $discuss = shift; |
752
|
0
|
|
|
|
|
|
my %p = @_; |
753
|
0
|
|
|
|
|
|
$self->info("更新讨论组[ ". $discuss->name . " ]信息"); |
754
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking}; |
755
|
|
|
|
|
|
|
my $handle = sub{ |
756
|
0
|
|
|
0
|
|
|
my $discuss_info = shift; |
757
|
0
|
0
|
|
|
|
|
if(defined $discuss_info){ |
758
|
0
|
0
|
|
|
|
|
if(ref $discuss_info->{member} eq 'ARRAY'){ |
759
|
0
|
|
|
|
|
|
$discuss->update($discuss_info); |
760
|
|
|
|
|
|
|
} |
761
|
0
|
|
|
|
|
|
else{$self->debug("更新讨论组[ " . $discuss->name . " ]成员信息无效")} |
762
|
|
|
|
|
|
|
} |
763
|
0
|
|
|
|
|
|
else{$self->warn("更新讨论组[ " . $discuss->name . " ]成员信息失败")} |
764
|
|
|
|
|
|
|
|
765
|
0
|
|
|
|
|
|
}; |
766
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
767
|
0
|
|
|
|
|
|
my $discuss_info = $self->_get_discuss_info($discuss->id); |
768
|
0
|
|
|
|
|
|
$handle->($discuss_info); |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
else{ |
771
|
0
|
|
|
|
|
|
$self->_get_discuss_info($discuss->id,$handle); |
772
|
|
|
|
|
|
|
} |
773
|
0
|
|
|
|
|
|
return $self; |
774
|
|
|
|
|
|
|
} |
775
|
0
|
|
|
|
|
|
my %p = @_; |
776
|
0
|
0
|
|
|
|
|
$p{is_blocking} = 1 if not defined $p{is_blocking} ; |
777
|
0
|
0
|
|
|
|
|
$p{is_update_discuss_member} = 1 if not defined $p{is_update_discuss_member} ; |
778
|
0
|
|
|
|
|
|
$self->info("更新讨论组列表信息..."); |
779
|
|
|
|
|
|
|
my $handle = sub{ |
780
|
0
|
|
|
0
|
|
|
my @discusss; |
781
|
0
|
|
|
|
|
|
my $discuss_list = shift; |
782
|
0
|
0
|
|
|
|
|
unless(defined $discuss_list){ |
783
|
0
|
|
|
|
|
|
$self->warn("更新讨论列表信息失败\n"); |
784
|
0
|
|
|
|
|
|
$self->emit("model_update","discuss",0); |
785
|
0
|
|
|
|
|
|
return $self; |
786
|
|
|
|
|
|
|
} |
787
|
0
|
|
|
|
|
|
for my $d (@{$discuss_list}){ |
|
0
|
|
|
|
|
|
|
788
|
0
|
|
|
|
|
|
push @discusss, Mojo::Webqq::Discuss->new($d); |
789
|
|
|
|
|
|
|
} |
790
|
0
|
0
|
0
|
|
|
|
if(ref $self->discuss eq "ARRAY" and @{$self->discuss} == 0){ |
|
0
|
|
|
|
|
|
|
791
|
0
|
|
|
|
|
|
$self->discuss(\@discusss); |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
else{ |
794
|
0
|
|
|
|
|
|
my($new_discusss,$lost_discusss,$sames) = $self->array_diff($self->discuss,\@discusss,sub{$_[0]->did}); |
|
0
|
|
|
|
|
|
|
795
|
0
|
|
|
|
|
|
for(@{$new_discusss}){ |
|
0
|
|
|
|
|
|
|
796
|
0
|
|
|
|
|
|
$self->add_discuss($_); |
797
|
0
|
|
|
|
|
|
$self->emit(new_discuss=>$_) ; |
798
|
|
|
|
|
|
|
} |
799
|
0
|
|
|
|
|
|
for(@{$lost_discusss}){ |
|
0
|
|
|
|
|
|
|
800
|
0
|
|
|
|
|
|
$self->remove_discuss($_); |
801
|
0
|
|
|
|
|
|
$self->emit(lose_discuss=>$_) ; |
802
|
|
|
|
|
|
|
} |
803
|
0
|
|
|
|
|
|
for(@{$sames}){ |
|
0
|
|
|
|
|
|
|
804
|
0
|
|
|
|
|
|
my($old_discuss,$new_discuss) = ($_->[0],$_->[1]); |
805
|
0
|
|
|
|
|
|
$old_discuss->update($new_discuss); |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
} |
808
|
0
|
|
|
|
|
|
$self->emit("model_update","discuss",1); |
809
|
0
|
0
|
|
|
|
|
if($p{is_update_discuss_member}){ |
810
|
0
|
|
|
|
|
|
for(@{ $self->discuss }){ |
|
0
|
|
|
|
|
|
|
811
|
0
|
|
|
|
|
|
$self->update_discuss_member($_,%p); |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
} |
814
|
0
|
|
|
|
|
|
}; |
815
|
0
|
0
|
|
|
|
|
if($p{is_blocking}){ |
816
|
0
|
|
|
|
|
|
my $discuss_list = $self->_get_discuss_list_info(); |
817
|
0
|
|
|
|
|
|
$handle->($discuss_list); |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
else{ |
820
|
0
|
|
|
|
|
|
$self->_get_discuss_list_info($handle); |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
sub search_discuss { |
825
|
1
|
|
|
1
|
|
8
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
283
|
|
826
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
827
|
0
|
|
|
|
|
|
my %p = @_; |
828
|
0
|
0
|
|
|
|
|
return if 0 == grep {defined $p{$_}} keys %p; |
|
0
|
|
|
|
|
|
|
829
|
0
|
0
|
|
|
|
|
$self->update_discuss(is_blocking=>1,is_update_discuss_member=>0) if @{$self->discuss} == 0; |
|
0
|
|
|
|
|
|
|
830
|
0
|
|
|
|
|
|
delete $p{member}; |
831
|
0
|
0
|
|
|
|
|
if(wantarray){ |
832
|
0
|
0
|
|
0
|
|
|
return grep {my $d = $_;(first {$p{$_} ne $d->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->discuss}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
else{ |
835
|
0
|
0
|
|
0
|
|
|
return first {my $d = $_;(first {$p{$_} ne $d->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @{$self->discuss}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
sub search_discuss_member { |
840
|
1
|
|
|
1
|
|
8
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2152
|
|
841
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
842
|
0
|
|
|
|
|
|
my %p = @_; |
843
|
0
|
0
|
|
|
|
|
return if 0 == grep {defined $p{$_}} keys %p; |
|
0
|
|
|
|
|
|
|
844
|
0
|
0
|
|
|
|
|
if(@{$self->discuss} == 0){ |
|
0
|
|
|
|
|
|
|
845
|
0
|
|
|
|
|
|
$self->update_discuss(is_blocking=>1,is_update_discuss_member=>1); |
846
|
|
|
|
|
|
|
} |
847
|
|
|
|
|
|
|
else{ |
848
|
0
|
|
|
|
|
|
for( @{$self->discuss}){ |
|
0
|
|
|
|
|
|
|
849
|
0
|
0
|
|
|
|
|
$_->update_discuss_member(is_blocking=>1,) if $_->is_empty; |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
} |
852
|
0
|
|
|
|
|
|
my @member = map {@{$_->member}} grep {ref $_->member eq "ARRAY"} @{$self->discuss}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
853
|
0
|
0
|
|
|
|
|
if(wantarray){ |
854
|
0
|
0
|
|
0
|
|
|
return grep {my $m = $_;(first {$p{$_} ne $m->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @member; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
else{ |
857
|
0
|
0
|
|
0
|
|
|
return first {my $m = $_;(first {$p{$_} ne $m->$_} grep {defined $p{$_}} keys %p) ? 0 : 1;} @member; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
sub invite_friend{ |
862
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
863
|
0
|
0
|
|
|
|
|
if ( not $self->is_support_model_ext){ |
864
|
0
|
|
|
|
|
|
$self->warn("无法支持获取扩展信息"); |
865
|
0
|
|
|
|
|
|
return; |
866
|
|
|
|
|
|
|
} |
867
|
0
|
|
|
|
|
|
my $group = shift; |
868
|
0
|
|
|
|
|
|
my @friends = @_; |
869
|
0
|
0
|
|
|
|
|
if(not defined $group->uid){ |
870
|
0
|
|
|
|
|
|
$self->error("未获取到群号码,无法邀请好友入群"); |
871
|
0
|
|
|
|
|
|
return; |
872
|
|
|
|
|
|
|
} |
873
|
0
|
0
|
0
|
|
|
|
if($group->role ne "manage" and $group->role ne "create"){ |
874
|
0
|
|
|
|
|
|
$self->error("非群主或管理员,无法邀请好友入群"); |
875
|
0
|
|
|
|
|
|
return; |
876
|
|
|
|
|
|
|
} |
877
|
0
|
|
|
|
|
|
for(@friends){ |
878
|
0
|
0
|
|
|
|
|
$self->die("非好友对象") if not $_->is_friend; |
879
|
|
|
|
|
|
|
} |
880
|
0
|
|
|
|
|
|
my $ret = $self->_invite_friend($group->uid,map {$_->uid} @friends); |
|
0
|
|
|
|
|
|
|
881
|
0
|
0
|
|
|
|
|
if($ret){$self->info("邀请好友入群成功")} |
|
0
|
|
|
|
|
|
|
882
|
0
|
|
|
|
|
|
else{$self->error("邀请好友入群失败")} |
883
|
0
|
|
|
|
|
|
return $ret; |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
sub kick_group_member{ |
886
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
887
|
0
|
0
|
|
|
|
|
if ( not $self->is_support_model_ext){ |
888
|
0
|
|
|
|
|
|
$self->warn("无法支持获取扩展信息"); |
889
|
0
|
|
|
|
|
|
return; |
890
|
|
|
|
|
|
|
} |
891
|
0
|
|
|
|
|
|
my $group = shift; |
892
|
0
|
|
|
|
|
|
my @members = @_; |
893
|
0
|
0
|
|
|
|
|
if(not defined $group->uid){ |
894
|
0
|
|
|
|
|
|
$self->error("未获取到群号码,无法踢除群成员"); |
895
|
0
|
|
|
|
|
|
return; |
896
|
|
|
|
|
|
|
} |
897
|
0
|
0
|
0
|
|
|
|
if($group->role ne "manage" and $group->role ne "create"){ |
898
|
0
|
|
|
|
|
|
$self->error("非群主或管理员,无法踢除群成员"); |
899
|
0
|
|
|
|
|
|
return; |
900
|
|
|
|
|
|
|
} |
901
|
0
|
|
|
|
|
|
for(@members){ |
902
|
0
|
0
|
|
|
|
|
$self->die("非群成员对象") if not $_->is_group_member; |
903
|
|
|
|
|
|
|
} |
904
|
0
|
|
|
|
|
|
my $ret = $self->_kick_group_member($group->uid,map {$_->uid} @members); |
|
0
|
|
|
|
|
|
|
905
|
0
|
0
|
|
|
|
|
if($ret){ |
906
|
0
|
|
|
|
|
|
for(@members){ |
907
|
0
|
|
|
|
|
|
$_->group->remove_group_member($_); |
908
|
0
|
|
|
|
|
|
$self->emit(lose_group_member=>$_); |
909
|
|
|
|
|
|
|
} |
910
|
0
|
|
|
|
|
|
$self->info("踢除群成员成功"); |
911
|
|
|
|
|
|
|
} |
912
|
0
|
|
|
|
|
|
else{$self->error("剔除群成员失败")} |
913
|
0
|
|
|
|
|
|
return $ret; |
914
|
|
|
|
|
|
|
} |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
sub shutup_group_member{ |
917
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
918
|
0
|
0
|
|
|
|
|
if ( not $self->is_support_model_ext){ |
919
|
0
|
|
|
|
|
|
$self->warn("无法支持获取扩展信息"); |
920
|
0
|
|
|
|
|
|
return; |
921
|
|
|
|
|
|
|
} |
922
|
0
|
|
|
|
|
|
my $group = shift; |
923
|
0
|
|
|
|
|
|
my $time = shift; |
924
|
0
|
|
|
|
|
|
my @members = @_; |
925
|
0
|
0
|
|
|
|
|
if($time<60){ |
926
|
0
|
|
|
|
|
|
$self->error("禁言时间太短,至少1分钟"); |
927
|
0
|
|
|
|
|
|
return; |
928
|
|
|
|
|
|
|
} |
929
|
0
|
0
|
|
|
|
|
if(not defined $group->uid){ |
930
|
0
|
|
|
|
|
|
$self->error("未获取到群号码,无法完成禁言操作"); |
931
|
0
|
|
|
|
|
|
return; |
932
|
|
|
|
|
|
|
} |
933
|
0
|
0
|
0
|
|
|
|
if($group->role ne "manage" and $group->role ne "create"){ |
934
|
0
|
|
|
|
|
|
$self->error("非群主或管理员,无法完成禁言操作"); |
935
|
0
|
|
|
|
|
|
return; |
936
|
|
|
|
|
|
|
} |
937
|
0
|
|
|
|
|
|
for(@members){ |
938
|
0
|
0
|
|
|
|
|
$self->die("非群成员对象") if not $_->is_group_member; |
939
|
0
|
0
|
0
|
|
|
|
if($_->role eq "admin" or $_->role eq "owner"){ |
940
|
0
|
|
|
|
|
|
$self->error("无法对群主或管理员进行禁言操作"); |
941
|
0
|
|
|
|
|
|
return; |
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
} |
944
|
0
|
|
|
|
|
|
my $ret = $self->_shutup_group_member($group->uid,$time,map {$_->uid} @members); |
|
0
|
|
|
|
|
|
|
945
|
0
|
0
|
|
|
|
|
if($ret){$self->info("禁言操作成功");} |
|
0
|
|
|
|
|
|
|
946
|
0
|
|
|
|
|
|
else{$self->error("禁言操作失败");} |
947
|
0
|
|
|
|
|
|
return $ret; |
948
|
|
|
|
|
|
|
} |
949
|
|
|
|
|
|
|
sub speakup_group_member{ |
950
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
951
|
0
|
0
|
|
|
|
|
if ( not $self->is_support_model_ext){ |
952
|
0
|
|
|
|
|
|
$self->warn("无法支持获取扩展信息"); |
953
|
0
|
|
|
|
|
|
return; |
954
|
|
|
|
|
|
|
} |
955
|
0
|
|
|
|
|
|
my $group = shift; |
956
|
0
|
|
|
|
|
|
my @members = @_; |
957
|
0
|
0
|
|
|
|
|
if(not defined $group->uid){ |
958
|
0
|
|
|
|
|
|
$self->error("未获取到群号码,无法完成禁言操作"); |
959
|
0
|
|
|
|
|
|
return; |
960
|
|
|
|
|
|
|
} |
961
|
0
|
0
|
0
|
|
|
|
if($group->role ne "manage" and $group->role ne "create"){ |
962
|
0
|
|
|
|
|
|
$self->error("非群主或管理员,无法完成禁言操作"); |
963
|
0
|
|
|
|
|
|
return; |
964
|
|
|
|
|
|
|
} |
965
|
0
|
|
|
|
|
|
for(@members){ |
966
|
0
|
0
|
|
|
|
|
$self->die("非群成员对象") if not $_->is_group_member; |
967
|
0
|
0
|
0
|
|
|
|
if($_->role eq "admin" or $_->role eq "owner"){ |
968
|
0
|
|
|
|
|
|
$self->error("无法对群主或管理员进行取消禁言操作"); |
969
|
0
|
|
|
|
|
|
return; |
970
|
|
|
|
|
|
|
} |
971
|
|
|
|
|
|
|
} |
972
|
0
|
|
|
|
|
|
my $ret = $self->_shutup_group_member($group->uid,0,map {$_->uid} @members); |
|
0
|
|
|
|
|
|
|
973
|
0
|
0
|
|
|
|
|
if($ret){$self->info("取消禁言操作成功");} |
|
0
|
|
|
|
|
|
|
974
|
0
|
|
|
|
|
|
else{$self->error("取消禁言操作失败");} |
975
|
0
|
|
|
|
|
|
return $ret; |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
sub set_group_admin{ |
978
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
979
|
0
|
0
|
|
|
|
|
if ( not $self->is_support_model_ext){ |
980
|
0
|
|
|
|
|
|
$self->warn("无法支持获取扩展信息"); |
981
|
0
|
|
|
|
|
|
return; |
982
|
|
|
|
|
|
|
} |
983
|
0
|
|
|
|
|
|
my $group = shift; |
984
|
0
|
|
|
|
|
|
my @members = @_; |
985
|
0
|
0
|
|
|
|
|
if(not defined $group->uid){ |
986
|
0
|
|
|
|
|
|
$self->error("未获取到群号码,无法设置管理员"); |
987
|
0
|
|
|
|
|
|
return; |
988
|
|
|
|
|
|
|
} |
989
|
0
|
0
|
|
|
|
|
if($group->role ne "create"){ |
990
|
0
|
|
|
|
|
|
$self->error("非群主,无法设置管理员"); |
991
|
0
|
|
|
|
|
|
return; |
992
|
|
|
|
|
|
|
} |
993
|
0
|
|
|
|
|
|
for(@members){ |
994
|
0
|
0
|
|
|
|
|
$self->die("非群成员对象") if not $_->is_group_member; |
995
|
|
|
|
|
|
|
} |
996
|
0
|
|
|
|
|
|
my $ret = $self->_set_group_admin($group->uid,map {$_->uid} @members); |
|
0
|
|
|
|
|
|
|
997
|
0
|
0
|
|
|
|
|
if($ret){ |
998
|
0
|
|
|
|
|
|
$_->role("admin") for(@members); |
999
|
0
|
|
|
|
|
|
$self->info("设置管理员成功"); |
1000
|
|
|
|
|
|
|
} |
1001
|
0
|
|
|
|
|
|
else{$self->error("设置管理员失败")} |
1002
|
0
|
|
|
|
|
|
return $ret; |
1003
|
|
|
|
|
|
|
} |
1004
|
|
|
|
|
|
|
sub remove_group_admin{ |
1005
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1006
|
0
|
|
|
|
|
|
my $group = shift; |
1007
|
0
|
|
|
|
|
|
my @members = @_; |
1008
|
0
|
0
|
|
|
|
|
if(not defined $group->uid){ |
1009
|
0
|
|
|
|
|
|
$self->error("未获取到群号码,无法移除管理员"); |
1010
|
0
|
|
|
|
|
|
return; |
1011
|
|
|
|
|
|
|
} |
1012
|
0
|
0
|
|
|
|
|
if($group->role ne "create"){ |
1013
|
0
|
|
|
|
|
|
$self->error("非群主,无法移除管理员"); |
1014
|
0
|
|
|
|
|
|
return; |
1015
|
|
|
|
|
|
|
} |
1016
|
0
|
|
|
|
|
|
for(@members){ |
1017
|
0
|
0
|
|
|
|
|
$self->die("非群成员对象") if not $_->is_group_member; |
1018
|
|
|
|
|
|
|
} |
1019
|
0
|
|
|
|
|
|
my $ret = $self->_remove_group_admin($group->uid,map {$_->uid} @members); |
|
0
|
|
|
|
|
|
|
1020
|
0
|
0
|
|
|
|
|
if($ret){ |
1021
|
0
|
|
|
|
|
|
$_->role("member") for(@members); |
1022
|
0
|
|
|
|
|
|
$self->info("移除管理员成功"); |
1023
|
|
|
|
|
|
|
} |
1024
|
0
|
|
|
|
|
|
else{$self->error("移除管理员失败")} |
1025
|
0
|
|
|
|
|
|
return $ret; |
1026
|
|
|
|
|
|
|
} |
1027
|
|
|
|
|
|
|
sub set_group_member_card{ |
1028
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1029
|
0
|
|
|
|
|
|
my $group = shift; |
1030
|
0
|
|
|
|
|
|
my $member = shift; |
1031
|
0
|
|
|
|
|
|
my $card = shift; |
1032
|
0
|
0
|
|
|
|
|
if(not defined $group->uid){ |
1033
|
0
|
|
|
|
|
|
$self->error("未获取到群号码,无法设置群名片"); |
1034
|
0
|
|
|
|
|
|
return; |
1035
|
|
|
|
|
|
|
} |
1036
|
0
|
0
|
0
|
|
|
|
if(!$member->is_me and $group->role ne "create" and $group->role ne "manage"){ |
|
|
|
0
|
|
|
|
|
1037
|
0
|
|
|
|
|
|
$self->error("非群主或管理员,无法设置其他人群名片"); |
1038
|
0
|
|
|
|
|
|
return; |
1039
|
|
|
|
|
|
|
} |
1040
|
0
|
0
|
|
|
|
|
$self->die("非群成员对象") if not $member->is_group_member; |
1041
|
0
|
|
|
|
|
|
my $ret = $self->_set_group_member_card($group->uid,$member->uid,$card); |
1042
|
0
|
0
|
|
|
|
|
if($ret){ |
1043
|
0
|
|
|
|
|
|
$member->card($card); |
1044
|
0
|
0
|
|
|
|
|
if(length $card){$self->info("设置群名片成功");} |
|
0
|
|
|
|
|
|
|
1045
|
0
|
|
|
|
|
|
else{$self->info("取消群名片成功");} |
1046
|
|
|
|
|
|
|
} |
1047
|
0
|
|
|
|
|
|
else{$self->error("设置群名片失败")} |
1048
|
0
|
|
|
|
|
|
return $ret; |
1049
|
|
|
|
|
|
|
} |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
sub qiandao { |
1052
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1053
|
0
|
|
|
|
|
|
my $group = shift; |
1054
|
0
|
0
|
|
|
|
|
if ( not $self->is_support_model_ext){ |
1055
|
0
|
|
|
|
|
|
$self->warn("无法支持获取扩展信息, 无法进行签到"); |
1056
|
0
|
|
|
|
|
|
return; |
1057
|
|
|
|
|
|
|
} |
1058
|
0
|
0
|
|
|
|
|
$self->die("非群组对象") if not $group->is_group; |
1059
|
0
|
0
|
|
|
|
|
if(not defined $group->uid){ |
1060
|
0
|
|
|
|
|
|
$self->error("未获取到群号码,无法进行签到"); |
1061
|
0
|
|
|
|
|
|
return; |
1062
|
|
|
|
|
|
|
} |
1063
|
0
|
|
|
|
|
|
my $ret = $self->_qiandao($group->uid); |
1064
|
0
|
0
|
|
|
|
|
if($ret){ |
1065
|
0
|
|
|
|
|
|
$self->info("群组[ ". $group->displayname ." ]签到成功"); |
1066
|
|
|
|
|
|
|
} |
1067
|
0
|
|
|
|
|
|
else{$self->error("群组[ ". $group->displayname ." ]签到失败")} |
1068
|
0
|
|
|
|
|
|
return $ret; |
1069
|
|
|
|
|
|
|
} |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
sub friends{ |
1072
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1073
|
0
|
0
|
|
|
|
|
$self->update_friend() if @{$self->friend} == 0; |
|
0
|
|
|
|
|
|
|
1074
|
0
|
|
|
|
|
|
return @{$self->friend}; |
|
0
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
} |
1076
|
|
|
|
|
|
|
sub groups{ |
1077
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1078
|
0
|
0
|
|
|
|
|
$self->update_group() if @{$self->group} == 0; |
|
0
|
|
|
|
|
|
|
1079
|
0
|
|
|
|
|
|
return @{$self->group}; |
|
0
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
sub discusss{ |
1082
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1083
|
0
|
0
|
|
|
|
|
$self->update_discuss() if @{$self->discuss} == 0; |
|
0
|
|
|
|
|
|
|
1084
|
0
|
|
|
|
|
|
return @{$self->discuss}; |
|
0
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
} |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
1; |