line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Webqq::Client; |
2
|
1
|
|
|
1
|
|
93390
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
32
|
|
3
|
1
|
|
|
1
|
|
481
|
use JSON; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
use Encode; |
5
|
|
|
|
|
|
|
use Time::HiRes qw(gettimeofday); |
6
|
|
|
|
|
|
|
use LWP::Protocol::https; |
7
|
|
|
|
|
|
|
use Storable qw(dclone); |
8
|
|
|
|
|
|
|
use List::Util qw(first); |
9
|
|
|
|
|
|
|
use base qw(Webqq::Message Webqq::Client::Cron Webqq::Client::Plugin); |
10
|
|
|
|
|
|
|
use Webqq::Client::Cache; |
11
|
|
|
|
|
|
|
use Webqq::Message::Queue; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
#定义模块的版本号 |
14
|
|
|
|
|
|
|
our $VERSION = "8.5.3"; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use LWP::UserAgent;#同步HTTP请求客户端 |
17
|
|
|
|
|
|
|
use Webqq::UserAgent;#异步HTTP请求客户端 |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use Webqq::Client::Util qw(console); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
#为避免在主文件中包含大量Method的代码,降低阅读性,故采用分文件加载的方式 |
22
|
|
|
|
|
|
|
#类似c语言中的.h文件和.c文件的关系 |
23
|
|
|
|
|
|
|
use Webqq::Client::Method::_prepare_for_login; |
24
|
|
|
|
|
|
|
use Webqq::Client::Method::_check_verify_code; |
25
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_img_verify_code; |
26
|
|
|
|
|
|
|
use Webqq::Client::Method::_login1; |
27
|
|
|
|
|
|
|
use Webqq::Client::Method::_check_sig; |
28
|
|
|
|
|
|
|
use Webqq::Client::Method::_login2; |
29
|
|
|
|
|
|
|
use Webqq::Client::Method::_recv_message; |
30
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_group_info; |
31
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_group_sig; |
32
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_group_list_info; |
33
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_user_friends; |
34
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_user_info; |
35
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_friend_info; |
36
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_stranger_info; |
37
|
|
|
|
|
|
|
use Webqq::Client::Method::_send_message; |
38
|
|
|
|
|
|
|
use Webqq::Client::Method::_send_group_message; |
39
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_vfwebqq; |
40
|
|
|
|
|
|
|
use Webqq::Client::Method::_send_sess_message; |
41
|
|
|
|
|
|
|
use Webqq::Client::Method::logout; |
42
|
|
|
|
|
|
|
use Webqq::Client::Method::get_qq_from_uin; |
43
|
|
|
|
|
|
|
use Webqq::Client::Method::get_single_long_nick; |
44
|
|
|
|
|
|
|
use Webqq::Client::Method::_report; |
45
|
|
|
|
|
|
|
use Webqq::Client::Method::get_dwz; |
46
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_offpic; |
47
|
|
|
|
|
|
|
use Webqq::Client::Method::_cookie_proxy; |
48
|
|
|
|
|
|
|
use Webqq::Client::Method::_relink; |
49
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_discuss_list_info; |
50
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_discuss_info; |
51
|
|
|
|
|
|
|
use Webqq::Client::Method::change_state; |
52
|
|
|
|
|
|
|
use Webqq::Client::Method::_send_discuss_message; |
53
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_friends_state; |
54
|
|
|
|
|
|
|
use Webqq::Client::Method::_get_recent_info; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
our $LAST_DISPATCH_TIME = undef; |
57
|
|
|
|
|
|
|
our $SEND_INTERVAL = 3; |
58
|
|
|
|
|
|
|
our $CLIENT_COUNT = 0; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub new { |
61
|
|
|
|
|
|
|
my $class = shift; |
62
|
|
|
|
|
|
|
my %p = @_; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
console "该模块已经停止使用和开发,请换用 Mojo::Webqq 参考文档: https://metacpan.org/pod/Mojo::Webqq\n"; |
65
|
|
|
|
|
|
|
exit; |
66
|
|
|
|
|
|
|
my $agent = 'Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062'; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
my ($second,$microsecond)=gettimeofday; |
69
|
|
|
|
|
|
|
my $send_msg_id = $second*1000+$microsecond; |
70
|
|
|
|
|
|
|
$send_msg_id=($send_msg_id-$send_msg_id%1000)/1000; |
71
|
|
|
|
|
|
|
$send_msg_id=($send_msg_id%10000)*10000; |
72
|
|
|
|
|
|
|
my $self = { |
73
|
|
|
|
|
|
|
cookie_jar => HTTP::Cookies->new(hide_cookie2=>1), |
74
|
|
|
|
|
|
|
qq_param => { |
75
|
|
|
|
|
|
|
qq => undef, |
76
|
|
|
|
|
|
|
pwd => undef, |
77
|
|
|
|
|
|
|
is_https => defined $p{security}?$p{security}:0, |
78
|
|
|
|
|
|
|
is_need_img_verifycode => 0, |
79
|
|
|
|
|
|
|
img_verifycode_source => 'TTY', #NONE|TTY|CALLBACK |
80
|
|
|
|
|
|
|
send_msg_id => $send_msg_id, |
81
|
|
|
|
|
|
|
clientid => 53999199, |
82
|
|
|
|
|
|
|
psessionid => 'null', |
83
|
|
|
|
|
|
|
vfwebqq => undef, |
84
|
|
|
|
|
|
|
ptwebqq => undef, |
85
|
|
|
|
|
|
|
state => $p{state} || 'online', #online|away|busy|silent|hidden|offline, |
86
|
|
|
|
|
|
|
passwd_sig => '', |
87
|
|
|
|
|
|
|
verifycode => undef, |
88
|
|
|
|
|
|
|
verifysession => undef, |
89
|
|
|
|
|
|
|
pt_verifysession => undef, |
90
|
|
|
|
|
|
|
md5_salt => undef, |
91
|
|
|
|
|
|
|
cap_cd => undef, |
92
|
|
|
|
|
|
|
isRandSalt => 0, |
93
|
|
|
|
|
|
|
ptvfsession => undef, |
94
|
|
|
|
|
|
|
api_check_sig => undef, |
95
|
|
|
|
|
|
|
g_pt_version => undef, |
96
|
|
|
|
|
|
|
g_login_sig => undef, |
97
|
|
|
|
|
|
|
g_style => 5, |
98
|
|
|
|
|
|
|
g_mibao_css => 'm_webqq', |
99
|
|
|
|
|
|
|
g_daid => 164, |
100
|
|
|
|
|
|
|
g_appid => 1003903, |
101
|
|
|
|
|
|
|
g_pt_version => 10092, |
102
|
|
|
|
|
|
|
rc => 1, |
103
|
|
|
|
|
|
|
}, |
104
|
|
|
|
|
|
|
qq_database => { |
105
|
|
|
|
|
|
|
user => {}, |
106
|
|
|
|
|
|
|
friends => [], |
107
|
|
|
|
|
|
|
group_list => [], |
108
|
|
|
|
|
|
|
discuss_list=> [], |
109
|
|
|
|
|
|
|
recent => [], |
110
|
|
|
|
|
|
|
group => [], |
111
|
|
|
|
|
|
|
discuss => [], |
112
|
|
|
|
|
|
|
}, |
113
|
|
|
|
|
|
|
encrypt_method => "perl", #perl|js |
114
|
|
|
|
|
|
|
is_first_login => -1, |
115
|
|
|
|
|
|
|
is_stop => 0, |
116
|
|
|
|
|
|
|
cache_for_uin_to_qq => Webqq::Client::Cache->new, |
117
|
|
|
|
|
|
|
cache_for_qq_to_uin => Webqq::Client::Cache->new, |
118
|
|
|
|
|
|
|
cache_for_number_to_uin => Webqq::Client::Cache->new, |
119
|
|
|
|
|
|
|
cache_for_uin_to_number => Webqq::Client::Cache->new, |
120
|
|
|
|
|
|
|
cache_for_group_sig => Webqq::Client::Cache->new, |
121
|
|
|
|
|
|
|
cache_for_stranger => Webqq::Client::Cache->new, |
122
|
|
|
|
|
|
|
cache_for_friend => Webqq::Client::Cache->new, |
123
|
|
|
|
|
|
|
cache_for_single_long_nick => Webqq::Client::Cache->new, |
124
|
|
|
|
|
|
|
cache_for_group => Webqq::Client::Cache->new, |
125
|
|
|
|
|
|
|
cache_for_group_member => Webqq::Client::Cache->new, |
126
|
|
|
|
|
|
|
cache_for_discuss => Webqq::Client::Cache->new, |
127
|
|
|
|
|
|
|
cache_for_discuss_member => Webqq::Client::Cache->new, |
128
|
|
|
|
|
|
|
cache_for_metacpan => Webqq::Client::Cache->new, |
129
|
|
|
|
|
|
|
on_receive_message => undef, |
130
|
|
|
|
|
|
|
on_receive_offpic => undef, |
131
|
|
|
|
|
|
|
on_send_message => undef, |
132
|
|
|
|
|
|
|
on_login => undef, |
133
|
|
|
|
|
|
|
on_new_friend => undef, |
134
|
|
|
|
|
|
|
on_new_group => undef, |
135
|
|
|
|
|
|
|
on_new_discuss => undef, |
136
|
|
|
|
|
|
|
on_new_group_member => undef, |
137
|
|
|
|
|
|
|
on_loss_group_member => undef, |
138
|
|
|
|
|
|
|
on_new_discuss_member => undef, |
139
|
|
|
|
|
|
|
on_loss_discuss_member => undef, |
140
|
|
|
|
|
|
|
on_input_img_verifycode => undef, |
141
|
|
|
|
|
|
|
on_friend_change_state => undef, |
142
|
|
|
|
|
|
|
on_run => undef, |
143
|
|
|
|
|
|
|
on_ready => undef, |
144
|
|
|
|
|
|
|
receive_message_queue => Webqq::Message::Queue->new, |
145
|
|
|
|
|
|
|
send_message_queue => Webqq::Message::Queue->new, |
146
|
|
|
|
|
|
|
debug => $p{debug}, |
147
|
|
|
|
|
|
|
login_state => "init", |
148
|
|
|
|
|
|
|
watchers => {}, |
149
|
|
|
|
|
|
|
type => $p{type} || 'smartqq',#webqq or smartqq |
150
|
|
|
|
|
|
|
plugin_num => 0, |
151
|
|
|
|
|
|
|
plugins => {}, |
152
|
|
|
|
|
|
|
ua_retry_times => 5, |
153
|
|
|
|
|
|
|
je => undef, |
154
|
|
|
|
|
|
|
poll_failure_count_max => 3, |
155
|
|
|
|
|
|
|
poll_failure_count => 0, |
156
|
|
|
|
|
|
|
client_version => $VERSION, |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
}; |
159
|
|
|
|
|
|
|
$self->{ua} = LWP::UserAgent->new( |
160
|
|
|
|
|
|
|
cookie_jar => $self->{cookie_jar}, |
161
|
|
|
|
|
|
|
agent => $agent, |
162
|
|
|
|
|
|
|
timeout => 300, |
163
|
|
|
|
|
|
|
ssl_opts => {verify_hostname => 0}, |
164
|
|
|
|
|
|
|
); |
165
|
|
|
|
|
|
|
$self->{asyn_ua} = Webqq::UserAgent->new( |
166
|
|
|
|
|
|
|
cookie_jar => $self->{cookie_jar}, |
167
|
|
|
|
|
|
|
agent => $agent, |
168
|
|
|
|
|
|
|
request_timeout => 300, |
169
|
|
|
|
|
|
|
inactivity_timeout => 300, |
170
|
|
|
|
|
|
|
); |
171
|
|
|
|
|
|
|
$self->{qq_param}{from_uin} =$self->{qq_param}{qq}; |
172
|
|
|
|
|
|
|
if($self->{debug}){ |
173
|
|
|
|
|
|
|
$self->{ua}->add_handler(request_send => sub { |
174
|
|
|
|
|
|
|
my($request, $ua, $h) = @_; |
175
|
|
|
|
|
|
|
print $request->as_string; |
176
|
|
|
|
|
|
|
return; |
177
|
|
|
|
|
|
|
}); |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
$self->{ua}->add_handler( |
180
|
|
|
|
|
|
|
response_header => sub { my($response, $ua, $h) = @_; |
181
|
|
|
|
|
|
|
print $response->as_string; |
182
|
|
|
|
|
|
|
return; |
183
|
|
|
|
|
|
|
}); |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
$self->{default_qq_param} = dclone($self->{qq_param}); |
186
|
|
|
|
|
|
|
$self->{default_qq_database} = dclone($self->{qq_database}); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
bless $self,$class; |
189
|
|
|
|
|
|
|
$self->_prepare(); |
190
|
|
|
|
|
|
|
return $self; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
sub on_send_message :lvalue { |
193
|
|
|
|
|
|
|
my $self = shift; |
194
|
|
|
|
|
|
|
$self->{on_send_message}; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
sub on_receive_message :lvalue{ |
198
|
|
|
|
|
|
|
my $self = shift; |
199
|
|
|
|
|
|
|
$self->{on_receive_message}; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub on_receive_offpic :lvalue{ |
203
|
|
|
|
|
|
|
my $self = shift; |
204
|
|
|
|
|
|
|
$self->{on_receive_offpic}; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub on_login :lvalue { |
208
|
|
|
|
|
|
|
my $self = shift; |
209
|
|
|
|
|
|
|
$self->{on_login}; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
sub on_ready :lvalue { |
212
|
|
|
|
|
|
|
my $self = shift; |
213
|
|
|
|
|
|
|
$self->{on_ready}; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
sub on_run :lvalue { |
216
|
|
|
|
|
|
|
my $self = shift; |
217
|
|
|
|
|
|
|
$self->{on_run}; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
sub on_friend_change_state :lvalue { |
220
|
|
|
|
|
|
|
my $self = shift; |
221
|
|
|
|
|
|
|
$self->{on_friend_change_state}; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub on_new_friend :lvalue { |
225
|
|
|
|
|
|
|
my $self = shift; |
226
|
|
|
|
|
|
|
$self->{on_new_friend}; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
sub on_new_group :lvalue { |
230
|
|
|
|
|
|
|
my $self = shift; |
231
|
|
|
|
|
|
|
$self->{on_new_group}; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub on_new_group_member :lvalue { |
235
|
|
|
|
|
|
|
my $self = shift; |
236
|
|
|
|
|
|
|
$self->{on_new_group_member}; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub on_loss_group_member :lvalue { |
240
|
|
|
|
|
|
|
my $self = shift; |
241
|
|
|
|
|
|
|
$self->{on_loss_group_member}; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub on_new_discuss :lvalue { |
245
|
|
|
|
|
|
|
my $self = shift; |
246
|
|
|
|
|
|
|
$self->{on_new_discuss}; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
sub on_new_discuss_member :lvalue { |
249
|
|
|
|
|
|
|
my $self = shift; |
250
|
|
|
|
|
|
|
$self->{on_new_discuss_member}; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
sub on_loss_discuss_member :lvalue { |
253
|
|
|
|
|
|
|
my $self = shift; |
254
|
|
|
|
|
|
|
$self->{on_loss_discuss_member}; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
sub on_input_img_verifycode :lvalue { |
258
|
|
|
|
|
|
|
my $self = shift; |
259
|
|
|
|
|
|
|
$self->{on_input_img_verifycode}; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub login{ |
263
|
|
|
|
|
|
|
my $self = shift; |
264
|
|
|
|
|
|
|
my %p = @_; |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
if($self->{is_first_login} == -1){ |
267
|
|
|
|
|
|
|
$self->{is_first_login} = 1; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
elsif($self->{is_first_login} == 1){ |
270
|
|
|
|
|
|
|
$self->{is_first_login} = 0; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
@{$self->{default_qq_param}}{qw(qq pwd)} = @p{qw(qq pwd)}; |
274
|
|
|
|
|
|
|
@{$self->{qq_param}}{qw(qq pwd)} = @p{qw(qq pwd)}; |
275
|
|
|
|
|
|
|
$self->{qq_param}{security} = $p{security} if defined $p{security}; |
276
|
|
|
|
|
|
|
$self->{qq_param}{state} = $p{state} |
277
|
|
|
|
|
|
|
if defined $p{state} and first {$_ eq $p{state}} qw(online away busy silent hidden offline); |
278
|
|
|
|
|
|
|
console "QQ账号: $self->{default_qq_param}{qq}\n"; |
279
|
|
|
|
|
|
|
#my $is_big_endian = unpack( 'xc', pack( 's', 1 ) ); |
280
|
|
|
|
|
|
|
$self->{qq_param}{qq} = $self->{default_qq_param}{qq}; |
281
|
|
|
|
|
|
|
$self->{default_qq_param}{pwd} = lc $self->{default_qq_param}{pwd}; |
282
|
|
|
|
|
|
|
$self->{qq_param}{pwd} = $self->{default_qq_param}{pwd} ; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
if( |
285
|
|
|
|
|
|
|
$self->_prepare_for_login() |
286
|
|
|
|
|
|
|
&& $self->_check_verify_code() |
287
|
|
|
|
|
|
|
&& $self->_get_img_verify_code() |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
){ |
290
|
|
|
|
|
|
|
while(){ |
291
|
|
|
|
|
|
|
my $ret = $self->_login1(); |
292
|
|
|
|
|
|
|
if($ret == -1){ |
293
|
|
|
|
|
|
|
$self->_get_img_verify_code(); |
294
|
|
|
|
|
|
|
next; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
elsif($ret == -2 and $self->{encrypt_method} ne "js"){#encrypt_method fail,change another |
297
|
|
|
|
|
|
|
console "登录失败,尝试更换加密算法计算方式,重新登录...\n"; |
298
|
|
|
|
|
|
|
$self->{encrypt_method} = "js"; |
299
|
|
|
|
|
|
|
$self->relogin(); |
300
|
|
|
|
|
|
|
return; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
elsif($ret == 1){ |
303
|
|
|
|
|
|
|
$self->_report() |
304
|
|
|
|
|
|
|
&& $self->_check_sig() |
305
|
|
|
|
|
|
|
&& $self->_get_vfwebqq() |
306
|
|
|
|
|
|
|
&& $self->_login2(); |
307
|
|
|
|
|
|
|
last; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
else{ |
310
|
|
|
|
|
|
|
last; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
#登录不成功,客户端退出运行 |
316
|
|
|
|
|
|
|
if($self->{login_state} ne 'success'){ |
317
|
|
|
|
|
|
|
console "登录失败,客户端退出(可能网络不稳定,请多尝试几次)\n"; |
318
|
|
|
|
|
|
|
$self->stop(); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
else{ |
321
|
|
|
|
|
|
|
console "登录成功\n"; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
#获取个人资料信息 |
324
|
|
|
|
|
|
|
$self->update_user_info(); |
325
|
|
|
|
|
|
|
#显示欢迎信息 |
326
|
|
|
|
|
|
|
$self->welcome(); |
327
|
|
|
|
|
|
|
#更新好友信息 |
328
|
|
|
|
|
|
|
$self->update_friends_info(); |
329
|
|
|
|
|
|
|
#更新群信息 |
330
|
|
|
|
|
|
|
$self->update_group_info(); |
331
|
|
|
|
|
|
|
#更新讨论组信息 |
332
|
|
|
|
|
|
|
$self->update_discuss_info(); |
333
|
|
|
|
|
|
|
#更新最近联系人信息 |
334
|
|
|
|
|
|
|
$self->update_recent_info(); |
335
|
|
|
|
|
|
|
#使用Webqq::Qun添加更多好友和群属性信息 |
336
|
|
|
|
|
|
|
$self->_update_extra_info(); |
337
|
|
|
|
|
|
|
#执行on_login回调 |
338
|
|
|
|
|
|
|
if(ref $self->{on_login} eq 'CODE'){ |
339
|
|
|
|
|
|
|
eval{ |
340
|
|
|
|
|
|
|
$self->{on_login}->(); |
341
|
|
|
|
|
|
|
}; |
342
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
return 1; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
sub relogin{ |
347
|
|
|
|
|
|
|
my $self = shift; |
348
|
|
|
|
|
|
|
console "正在重新登录...\n"; |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
$self->logout(); |
351
|
|
|
|
|
|
|
$self->{login_state} = 'relogin'; |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
#清空cookie |
354
|
|
|
|
|
|
|
$self->{cookie_jar} = HTTP::Cookies->new(hide_cookie2=>1); |
355
|
|
|
|
|
|
|
$self->{ua}->cookie_jar($self->{cookie_jar}); |
356
|
|
|
|
|
|
|
$self->{asyn_ua}->{cookie_jar} = $self->{cookie_jar}; |
357
|
|
|
|
|
|
|
#重新设置初始化参数 |
358
|
|
|
|
|
|
|
$self->{cache_for_uin_to_qq} = Webqq::Client::Cache->new; |
359
|
|
|
|
|
|
|
$self->{cache_for_qq_to_uin} = Webqq::Client::Cache->new; |
360
|
|
|
|
|
|
|
$self->{cache_for_number_to_uin} = Webqq::Client::Cache->new; |
361
|
|
|
|
|
|
|
$self->{cache_for_uin_to_number} = Webqq::Client::Cache->new; |
362
|
|
|
|
|
|
|
$self->{cache_for_group_sig} = Webqq::Client::Cache->new; |
363
|
|
|
|
|
|
|
$self->{cache_for_group} = Webqq::Client::Cache->new; |
364
|
|
|
|
|
|
|
$self->{cache_for_group_member} = Webqq::Client::Cache->new; |
365
|
|
|
|
|
|
|
$self->{cache_for_discuss} = Webqq::Client::Cache->new; |
366
|
|
|
|
|
|
|
$self->{cache_for_discuss_member} = Webqq::Client::Cache->new; |
367
|
|
|
|
|
|
|
$self->{cache_for_friend} = Webqq::Client::Cache->new; |
368
|
|
|
|
|
|
|
$self->{cache_for_stranger} = Webqq::Client::Cache->new; |
369
|
|
|
|
|
|
|
$self->{cache_for_single_long_nick} = Webqq::Client::Cache->new; |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
$self->{qq_param} = dclone($self->{default_qq_param}); |
372
|
|
|
|
|
|
|
$self->{qq_database} = dclone($self->{default_qq_database}); |
373
|
|
|
|
|
|
|
$self->login(qq=>$self->{default_qq_param}{qq},pwd=>$self->{default_qq_param}{pwd}); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
sub _get_vfwebqq; |
376
|
|
|
|
|
|
|
sub _prepare_for_login; |
377
|
|
|
|
|
|
|
sub _check_verify_code; |
378
|
|
|
|
|
|
|
sub _get_img_verify_code; |
379
|
|
|
|
|
|
|
sub _check_sig; |
380
|
|
|
|
|
|
|
sub _login1; |
381
|
|
|
|
|
|
|
sub _login2; |
382
|
|
|
|
|
|
|
sub _get_user_info; |
383
|
|
|
|
|
|
|
sub _get_friend_info; |
384
|
|
|
|
|
|
|
sub _get_group_info; |
385
|
|
|
|
|
|
|
sub _get_group_list_info; |
386
|
|
|
|
|
|
|
sub _get_user_friends; |
387
|
|
|
|
|
|
|
sub _get_discuss_list_info; |
388
|
|
|
|
|
|
|
sub _send_message; |
389
|
|
|
|
|
|
|
sub _send_group_message; |
390
|
|
|
|
|
|
|
sub _get_msg_tip; |
391
|
|
|
|
|
|
|
sub change_state; |
392
|
|
|
|
|
|
|
sub get_qq_from_uin; |
393
|
|
|
|
|
|
|
sub get_single_long_nick; |
394
|
|
|
|
|
|
|
sub _report; |
395
|
|
|
|
|
|
|
sub _cookie_proxy; |
396
|
|
|
|
|
|
|
sub _get_offpic; |
397
|
|
|
|
|
|
|
sub _relink; |
398
|
|
|
|
|
|
|
sub _get_discuss_list_info; |
399
|
|
|
|
|
|
|
sub _get_discuss_info; |
400
|
|
|
|
|
|
|
sub _get_friends_state; |
401
|
|
|
|
|
|
|
sub _get_recent_info; |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
#接受一个消息,将它放到发送消息队列中 |
404
|
|
|
|
|
|
|
sub send_message{ |
405
|
|
|
|
|
|
|
my $self = shift; |
406
|
|
|
|
|
|
|
if(@_ == 1 and ref $_[0] eq 'Webqq::Message::Message::Send'){ |
407
|
|
|
|
|
|
|
my $msg = shift; |
408
|
|
|
|
|
|
|
$self->{send_message_queue}->put($msg); |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
else{ |
411
|
|
|
|
|
|
|
my $msg = $self->_create_msg(@_,type=>'message'); |
412
|
|
|
|
|
|
|
$self->{send_message_queue}->put($msg); |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
}; |
415
|
|
|
|
|
|
|
#接受一个群临时消息,将它放到发送消息队列中 |
416
|
|
|
|
|
|
|
sub send_sess_message{ |
417
|
|
|
|
|
|
|
my $self = shift; |
418
|
|
|
|
|
|
|
if(@_ == 1 and ref $_[0] eq 'Webqq::Message::SessMessage::Send'){ |
419
|
|
|
|
|
|
|
my $msg = shift; |
420
|
|
|
|
|
|
|
$self->{send_message_queue}->put($msg); |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
else{ |
423
|
|
|
|
|
|
|
my $msg = $self->_create_msg(@_,type=>'sess_message'); |
424
|
|
|
|
|
|
|
$self->{send_message_queue}->put($msg); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub send_discuss_message { |
429
|
|
|
|
|
|
|
my $self = shift; |
430
|
|
|
|
|
|
|
if(@_ == 1 and ref $_[0] eq 'Webqq::Message::DiscussMessage::Send'){ |
431
|
|
|
|
|
|
|
my $msg = shift; |
432
|
|
|
|
|
|
|
$self->{send_message_queue}->put($msg); |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
else{ |
435
|
|
|
|
|
|
|
my $msg = $self->_create_msg(@_,type=>'discuss_message'); |
436
|
|
|
|
|
|
|
$self->{send_message_queue}->put($msg); |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
}; |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
#接受一个群消息,将它放到发送消息队列中 |
441
|
|
|
|
|
|
|
sub send_group_message{ |
442
|
|
|
|
|
|
|
my $self = shift; |
443
|
|
|
|
|
|
|
if(@_ == 1 and ref $_[0] eq 'Webqq::Message::GroupMessage::Send'){ |
444
|
|
|
|
|
|
|
my $msg = shift; |
445
|
|
|
|
|
|
|
$self->{send_message_queue}->put($msg); |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
else{ |
448
|
|
|
|
|
|
|
my $msg = $self->_create_msg(@_,type=>'group_message'); |
449
|
|
|
|
|
|
|
$self->{send_message_queue}->put($msg); |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
}; |
452
|
|
|
|
|
|
|
sub welcome{ |
453
|
|
|
|
|
|
|
my $self = shift; |
454
|
|
|
|
|
|
|
my $w = $self->{qq_database}{user}; |
455
|
|
|
|
|
|
|
console "欢迎回来, $w->{nick}($w->{province})\n"; |
456
|
|
|
|
|
|
|
console "个性签名: " . ($w->{single_long_nick}?$w->{single_long_nick}:"(无)") . "\n" |
457
|
|
|
|
|
|
|
}; |
458
|
|
|
|
|
|
|
sub logout; |
459
|
|
|
|
|
|
|
sub _prepare { |
460
|
|
|
|
|
|
|
my $self = shift; |
461
|
|
|
|
|
|
|
$self->_load_extra_accessor(); |
462
|
|
|
|
|
|
|
#设置从接收消息队列中接收到消息后对应的处理函数 |
463
|
|
|
|
|
|
|
$self->{receive_message_queue}->get(sub{ |
464
|
|
|
|
|
|
|
my $msg = shift; |
465
|
|
|
|
|
|
|
return if $self->{is_stop}; |
466
|
|
|
|
|
|
|
#触发on_new_friend/on_new_group_member回调 |
467
|
|
|
|
|
|
|
if($msg->{type} eq 'message'){ |
468
|
|
|
|
|
|
|
if(ref $self->{on_receive_offpic} eq 'CODE'){ |
469
|
|
|
|
|
|
|
for(@{$msg->{raw_content}}){ |
470
|
|
|
|
|
|
|
if($_->{type} eq 'offpic'){ |
471
|
|
|
|
|
|
|
$self->_get_offpic($_->{file_path},$msg->{from_uin},$self->{on_receive_offpic}); |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
$self->_detect_new_friend($msg->{from_uin}); |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
elsif($msg->{type} eq 'group_message'){ |
478
|
|
|
|
|
|
|
$self->_detect_new_group($msg->{group_code}); |
479
|
|
|
|
|
|
|
$self->_detect_new_group_member($msg->{group_code},$msg->{send_uin}); |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
elsif($msg->{type} eq 'discuss_message'){ |
482
|
|
|
|
|
|
|
$self->_detect_new_discuss($msg->{did}); |
483
|
|
|
|
|
|
|
$self->_detect_new_discuss_member($msg->{did},$msg->{send_uin}); |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
elsif($msg->{type} eq 'buddies_status_change'){ |
486
|
|
|
|
|
|
|
my $who = $self->update_friend_state_info($msg->{uin},$msg->{state},$msg->{client_type}); |
487
|
|
|
|
|
|
|
if(defined $who and ref $self->{on_friend_change_state} eq 'CODE'){ |
488
|
|
|
|
|
|
|
eval{ |
489
|
|
|
|
|
|
|
$self->{on_friend_change_state}->($who); |
490
|
|
|
|
|
|
|
}; |
491
|
|
|
|
|
|
|
console "$@\n" if $@; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
#接收队列中接收到消息后,调用相关的消息处理回调,如果未设置回调,消息将丢弃 |
496
|
|
|
|
|
|
|
if(ref $self->{on_receive_message} eq 'CODE'){ |
497
|
|
|
|
|
|
|
eval{ |
498
|
|
|
|
|
|
|
$self->{on_receive_message}->($msg); |
499
|
|
|
|
|
|
|
}; |
500
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
}); |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
#设置从发送消息队列中提取到消息后对应的处理函数 |
505
|
|
|
|
|
|
|
$self->{send_message_queue}->get(sub{ |
506
|
|
|
|
|
|
|
my $msg = shift; |
507
|
|
|
|
|
|
|
return if $self->{is_stop}; |
508
|
|
|
|
|
|
|
#消息的ttl值减少到0则丢弃消息 |
509
|
|
|
|
|
|
|
if($msg->{ttl} <= 0){ |
510
|
|
|
|
|
|
|
my $status = {is_success=>0,status=>"发送失败"}; |
511
|
|
|
|
|
|
|
if(ref $msg->{cb} eq 'CODE'){ |
512
|
|
|
|
|
|
|
$msg->{cb}->( |
513
|
|
|
|
|
|
|
$msg, |
514
|
|
|
|
|
|
|
$status->{is_success}, |
515
|
|
|
|
|
|
|
$status->{status}, |
516
|
|
|
|
|
|
|
); |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
if(ref $self->{on_send_message} eq 'CODE'){ |
519
|
|
|
|
|
|
|
$self->{on_send_message}->( |
520
|
|
|
|
|
|
|
$msg, |
521
|
|
|
|
|
|
|
$status->{is_success}, |
522
|
|
|
|
|
|
|
$status->{status}, |
523
|
|
|
|
|
|
|
); |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
return; |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
$msg->{ttl}--; |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
my $rand_watcher_id = rand(); |
531
|
|
|
|
|
|
|
my $delay = 0; |
532
|
|
|
|
|
|
|
my $now = time; |
533
|
|
|
|
|
|
|
if(defined $LAST_DISPATCH_TIME){ |
534
|
|
|
|
|
|
|
$delay = $now<$LAST_DISPATCH_TIME+$SEND_INTERVAL? |
535
|
|
|
|
|
|
|
$LAST_DISPATCH_TIME+$SEND_INTERVAL-$now |
536
|
|
|
|
|
|
|
: 0; |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
$self->{watchers}{$rand_watcher_id} = AE::timer $delay,0,sub{ |
539
|
|
|
|
|
|
|
delete $self->{watchers}{$rand_watcher_id}; |
540
|
|
|
|
|
|
|
$msg->{msg_time} = time; |
541
|
|
|
|
|
|
|
$msg->{type} eq 'message' ? $self->_send_message($msg) |
542
|
|
|
|
|
|
|
: $msg->{type} eq 'group_message' ? $self->_send_group_message($msg) |
543
|
|
|
|
|
|
|
: $msg->{type} eq 'sess_message' ? $self->_send_sess_message($msg) |
544
|
|
|
|
|
|
|
: $msg->{type} eq 'discuss_message' ? $self->_send_discuss_message($msg) |
545
|
|
|
|
|
|
|
: undef |
546
|
|
|
|
|
|
|
; |
547
|
|
|
|
|
|
|
}; |
548
|
|
|
|
|
|
|
$LAST_DISPATCH_TIME = $now+$delay; |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
}); |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
}; |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub ready{ |
555
|
|
|
|
|
|
|
my $self = shift; |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
$self->{watchers}{rand()} = AE::timer 600,600,sub{ |
558
|
|
|
|
|
|
|
$self->update_group_info(); |
559
|
|
|
|
|
|
|
$self->_update_extra_info(type=>"group"); |
560
|
|
|
|
|
|
|
}; |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
$self->{watchers}{rand()} = AE::timer 600+60,600,sub{ |
563
|
|
|
|
|
|
|
$self->update_discuss_info(); |
564
|
|
|
|
|
|
|
}; |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
console "开始接收消息\n"; |
567
|
|
|
|
|
|
|
$self->_recv_message(); |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
if(ref $self->{on_ready} eq 'CODE'){ |
570
|
|
|
|
|
|
|
eval{ |
571
|
|
|
|
|
|
|
$self->{on_ready}->(); |
572
|
|
|
|
|
|
|
}; |
573
|
|
|
|
|
|
|
console "$@\n" if $@; |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
$CLIENT_COUNT++; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
sub stop { |
579
|
|
|
|
|
|
|
my $self = shift; |
580
|
|
|
|
|
|
|
$self->{is_stop} = 1; |
581
|
|
|
|
|
|
|
if($CLIENT_COUNT > 1){ |
582
|
|
|
|
|
|
|
$CLIENT_COUNT--; |
583
|
|
|
|
|
|
|
$self->{watchers}{rand()} = AE::timer 600,0,sub{ |
584
|
|
|
|
|
|
|
undef %$self; |
585
|
|
|
|
|
|
|
}; |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
else{ |
588
|
|
|
|
|
|
|
CORE::exit; |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
sub exit { |
593
|
|
|
|
|
|
|
my $self = shift; |
594
|
|
|
|
|
|
|
CORE::exit(); |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
sub EXIT { |
598
|
|
|
|
|
|
|
CORE::exit(); |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
sub run{ |
602
|
|
|
|
|
|
|
my $self = shift; |
603
|
|
|
|
|
|
|
$self->ready(); |
604
|
|
|
|
|
|
|
if(ref $self->{on_run} eq 'CODE'){ |
605
|
|
|
|
|
|
|
eval{ |
606
|
|
|
|
|
|
|
$self->{on_run}->(); |
607
|
|
|
|
|
|
|
}; |
608
|
|
|
|
|
|
|
console "$@\n" if $@; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
console "客户端运行中...\n"; |
611
|
|
|
|
|
|
|
$self->{cv} = AE::cv; |
612
|
|
|
|
|
|
|
$self->{cv}->recv |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
sub RUN{ |
616
|
|
|
|
|
|
|
console "启动全局事件循环...\n"; |
617
|
|
|
|
|
|
|
AE::cv->recv; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
sub search_cookie{ |
620
|
|
|
|
|
|
|
my($self,$cookie) = @_; |
621
|
|
|
|
|
|
|
my $result = undef; |
622
|
|
|
|
|
|
|
$self->{cookie_jar}->scan(sub{ |
623
|
|
|
|
|
|
|
my($version,$key,$val,$path,$domain,$port,$path_spec,$secure,$expires,$discard,$rest) =@_; |
624
|
|
|
|
|
|
|
if($key eq $cookie){ |
625
|
|
|
|
|
|
|
$result = $val ; |
626
|
|
|
|
|
|
|
return; |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
}); |
629
|
|
|
|
|
|
|
return $result; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
#根据uin进行查询,返回一个friend的hash引用 |
633
|
|
|
|
|
|
|
#这个hash引用的结构是: |
634
|
|
|
|
|
|
|
#{ |
635
|
|
|
|
|
|
|
# flag #标志,作用未知 |
636
|
|
|
|
|
|
|
# face #表情 |
637
|
|
|
|
|
|
|
# uin #uin |
638
|
|
|
|
|
|
|
# categories #所属分组 |
639
|
|
|
|
|
|
|
# nick #昵称 |
640
|
|
|
|
|
|
|
# markname #备注名称 |
641
|
|
|
|
|
|
|
# is_vip #是否是vip会员 |
642
|
|
|
|
|
|
|
# vip_level #vip等级 |
643
|
|
|
|
|
|
|
#} |
644
|
|
|
|
|
|
|
sub search_friend { |
645
|
|
|
|
|
|
|
my ($self,$uin) = @_; |
646
|
|
|
|
|
|
|
my $cache_data = $self->{cache_for_friend}->retrieve($uin); |
647
|
|
|
|
|
|
|
return $cache_data if defined $cache_data; |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
my $f = first {$_->{uin} eq $uin} @{ $self->{qq_database}{friends} }; |
650
|
|
|
|
|
|
|
if(defined $f){ |
651
|
|
|
|
|
|
|
my $f_clone = dclone($f); |
652
|
|
|
|
|
|
|
$self->{cache_for_friend}->store($uin,$f_clone); |
653
|
|
|
|
|
|
|
return $f_clone; |
654
|
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
return undef; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
#根据群的gcode和群成员的uin进行查询,返回群成员相关信息 |
659
|
|
|
|
|
|
|
#返回结果是一个群成员的hash引用 |
660
|
|
|
|
|
|
|
#{ |
661
|
|
|
|
|
|
|
# nick #昵称 |
662
|
|
|
|
|
|
|
# province #省份 |
663
|
|
|
|
|
|
|
# gender #性别 |
664
|
|
|
|
|
|
|
# uin #uin |
665
|
|
|
|
|
|
|
# country #国家 |
666
|
|
|
|
|
|
|
# city #城市 |
667
|
|
|
|
|
|
|
#} |
668
|
|
|
|
|
|
|
sub search_member_in_group{ |
669
|
|
|
|
|
|
|
my ($self,$gcode,$member_uin) = @_; |
670
|
|
|
|
|
|
|
my $cache_data = $self->{cache_for_group_member}->retrieve("$gcode|$member_uin"); |
671
|
|
|
|
|
|
|
return $cache_data if defined $cache_data; |
672
|
|
|
|
|
|
|
#在现有的群中查找 |
673
|
|
|
|
|
|
|
for my $g (@{$self->{qq_database}{group}}){ |
674
|
|
|
|
|
|
|
#如果群是存在的 |
675
|
|
|
|
|
|
|
if($g->{ginfo}{code} eq $gcode){ |
676
|
|
|
|
|
|
|
#在群中查找指定的成员 |
677
|
|
|
|
|
|
|
#如果群数据库中包含群成员数据 |
678
|
|
|
|
|
|
|
if(exists $g->{minfo} and ref $g->{minfo} eq 'ARRAY'){ |
679
|
|
|
|
|
|
|
my $m = first {$_->{uin} eq $member_uin} @{$g->{minfo} }; |
680
|
|
|
|
|
|
|
if(defined $m){ |
681
|
|
|
|
|
|
|
my $m_clone = dclone($m); |
682
|
|
|
|
|
|
|
$self->{cache_for_group_member}->store("$gcode|$member_uin",$m_clone); |
683
|
|
|
|
|
|
|
return $m_clone; |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
return undef; |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
#群数据中只有ginfo,没有minfo |
689
|
|
|
|
|
|
|
else{ |
690
|
|
|
|
|
|
|
#尝试重新更新一下群信息,希望可以拿到minfo |
691
|
|
|
|
|
|
|
my $group_info = $self->_get_group_info($g->{ginfo}{code}); |
692
|
|
|
|
|
|
|
if(defined $group_info and ref $group_info->{minfo} eq 'ARRAY'){ |
693
|
|
|
|
|
|
|
#终于拿到minfo了 赶紧存起来 以备下次使用 |
694
|
|
|
|
|
|
|
$self->update_group_info($group_info); |
695
|
|
|
|
|
|
|
#在minfo里找群成员 |
696
|
|
|
|
|
|
|
my $m = first {$_->{uin} eq $member_uin} @{$group_info->{minfo}}; |
697
|
|
|
|
|
|
|
if(defined $m){ |
698
|
|
|
|
|
|
|
my $m_clone = dclone($m); |
699
|
|
|
|
|
|
|
$self->{cache_for_group_member}->store("$gcode|$member_uin",$m_clone); |
700
|
|
|
|
|
|
|
return $m_clone; |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
#靠 还是没找到 |
703
|
|
|
|
|
|
|
return undef; |
704
|
|
|
|
|
|
|
} |
705
|
|
|
|
|
|
|
#很可惜,还是拿不到minfo |
706
|
|
|
|
|
|
|
else{ |
707
|
|
|
|
|
|
|
return undef; |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
#遍历所有的群也找不到,返回undef |
713
|
|
|
|
|
|
|
return undef; |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
sub search_member_in_discuss { |
717
|
|
|
|
|
|
|
my ($self,$did,$member_uin) = @_; |
718
|
|
|
|
|
|
|
my $cache_data = $self->{cache_for_discuss_member}->retrieve("$did|$member_uin"); |
719
|
|
|
|
|
|
|
return $cache_data if defined $cache_data; |
720
|
|
|
|
|
|
|
#在现有的讨论组中查找 |
721
|
|
|
|
|
|
|
for my $d (@{$self->{qq_database}{discuss}}){ |
722
|
|
|
|
|
|
|
#如果讨论组是存在的 |
723
|
|
|
|
|
|
|
if($d->{dinfo}{did} eq $did){ |
724
|
|
|
|
|
|
|
#在讨论组中查找指定的成员 |
725
|
|
|
|
|
|
|
#如果讨论组数据库中包含讨论组成员数据 |
726
|
|
|
|
|
|
|
if(exists $d->{minfo} and ref $d->{minfo} eq 'ARRAY'){ |
727
|
|
|
|
|
|
|
my $m = first {$_->{uin} eq $member_uin} @{$d->{minfo} }; |
728
|
|
|
|
|
|
|
if(defined $m){ |
729
|
|
|
|
|
|
|
my $m_clone = dclone($m); |
730
|
|
|
|
|
|
|
$self->{cache_for_discuss_member}->store("$did|$member_uin",$m_clone); |
731
|
|
|
|
|
|
|
return $m_clone; |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
return undef; |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
#群数据中只有dinfo,没有minfo |
737
|
|
|
|
|
|
|
else{ |
738
|
|
|
|
|
|
|
#尝试重新更新一下讨论组信息,希望可以拿到minfo |
739
|
|
|
|
|
|
|
my $discuss_info = $self->_get_discuss_info($did); |
740
|
|
|
|
|
|
|
if(defined $discuss_info and ref $discuss_info->{minfo} eq 'ARRAY'){ |
741
|
|
|
|
|
|
|
#终于拿到minfo了 赶紧存起来 以备下次使用 |
742
|
|
|
|
|
|
|
$self->update_discuss_info($discuss_info); |
743
|
|
|
|
|
|
|
#在minfo里找讨论组成员 |
744
|
|
|
|
|
|
|
my $m = first {$_->{uin} eq $member_uin} @{$discuss_info->{minfo}}; |
745
|
|
|
|
|
|
|
if(defined $m){ |
746
|
|
|
|
|
|
|
my $m_clone = dclone($m); |
747
|
|
|
|
|
|
|
$self->{cache_for_discuss_member}->store("$did|$member_uin",$m_clone); |
748
|
|
|
|
|
|
|
return $m_clone; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
#靠 还是没找到 |
751
|
|
|
|
|
|
|
return undef; |
752
|
|
|
|
|
|
|
} |
753
|
|
|
|
|
|
|
#很可惜,还是拿不到minfo |
754
|
|
|
|
|
|
|
else{ |
755
|
|
|
|
|
|
|
return undef; |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
#遍历所有的群也找不到,返回undef |
761
|
|
|
|
|
|
|
return undef; |
762
|
|
|
|
|
|
|
} |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
sub search_discuss{ |
765
|
|
|
|
|
|
|
my $self = shift; |
766
|
|
|
|
|
|
|
my $did = shift; |
767
|
|
|
|
|
|
|
my $cache_data = $self->{cache_for_discuss}->retrieve($did); |
768
|
|
|
|
|
|
|
return $cache_data if defined $cache_data; |
769
|
|
|
|
|
|
|
my $d = first {$_->{dinfo}{did} eq $did} @{ $self->{qq_database}{discuss} }; |
770
|
|
|
|
|
|
|
if(defined $d){ |
771
|
|
|
|
|
|
|
my $clone = dclone($d->{dinfo}); |
772
|
|
|
|
|
|
|
$self->{cache_for_discuss}->store($did,$clone); |
773
|
|
|
|
|
|
|
return $clone; |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
return undef; |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
sub search_stranger{ |
779
|
|
|
|
|
|
|
my($self,$tuin) = @_; |
780
|
|
|
|
|
|
|
my $cache_data = $self->{cache_for_stranger}->retrieve($tuin); |
781
|
|
|
|
|
|
|
return $cache_data if defined $cache_data; |
782
|
|
|
|
|
|
|
for my $g ( @{$self->{qq_database}{group}} ){ |
783
|
|
|
|
|
|
|
for my $m (@{ $g->{minfo} }){ |
784
|
|
|
|
|
|
|
if($m->{uin} eq $tuin){ |
785
|
|
|
|
|
|
|
my $m_clone = dclone($m); |
786
|
|
|
|
|
|
|
$self->{cache_for_stranger}->store($tuin,$m_clone); |
787
|
|
|
|
|
|
|
return $m_clone; |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
$self->_get_stranger_info($tuin) or undef; |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
sub search_group{ |
796
|
|
|
|
|
|
|
my($self,$gcode) = @_; |
797
|
|
|
|
|
|
|
my $cache_data = $self->{cache_for_group}->retrieve($gcode); |
798
|
|
|
|
|
|
|
return $cache_data if defined $cache_data; |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
my $g = first {$_->{ginfo}{code} eq $gcode} @{ $self->{qq_database}{group} }; |
801
|
|
|
|
|
|
|
if(defined $g){ |
802
|
|
|
|
|
|
|
my $clone = dclone($g->{ginfo}); |
803
|
|
|
|
|
|
|
$self->{cache_for_group}->store($gcode,$clone); |
804
|
|
|
|
|
|
|
return $clone; |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
return undef ; |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
sub update_user_info{ |
810
|
|
|
|
|
|
|
my $self = shift; |
811
|
|
|
|
|
|
|
console "更新个人信息...\n"; |
812
|
|
|
|
|
|
|
my $user_info = $self->_get_user_info(); |
813
|
|
|
|
|
|
|
if(defined $user_info){ |
814
|
|
|
|
|
|
|
for my $key (keys %{ $user_info }){ |
815
|
|
|
|
|
|
|
if($key eq 'birthday'){ |
816
|
|
|
|
|
|
|
$self->{qq_database}{user}{birthday} = |
817
|
|
|
|
|
|
|
encode("utf8", join("-",@{ $user_info->{birthday}}{qw(year month day)} ) ); |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
else{ |
820
|
|
|
|
|
|
|
$self->{qq_database}{user}{$key} = encode("utf8",$user_info->{$key}); |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
my $single_long_nick = $self->get_single_long_nick($self->{qq_param}{qq}); |
824
|
|
|
|
|
|
|
if(defined $single_long_nick){ |
825
|
|
|
|
|
|
|
$self->{qq_database}{user}{single_long_nick} = $single_long_nick; |
826
|
|
|
|
|
|
|
} |
827
|
|
|
|
|
|
|
$self->{qq_database}{user}{qq} = $self->{qq_param}{qq}; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
else{console "更新个人信息失败\n";} |
830
|
|
|
|
|
|
|
} |
831
|
|
|
|
|
|
|
sub update_friends_info{ |
832
|
|
|
|
|
|
|
my $self=shift; |
833
|
|
|
|
|
|
|
my $friend = shift; |
834
|
|
|
|
|
|
|
if(defined $friend){ |
835
|
|
|
|
|
|
|
for(@{ $self->{qq_database}{friends} }){ |
836
|
|
|
|
|
|
|
if($_->{uin} eq $friend->{uin}){ |
837
|
|
|
|
|
|
|
$_ = $friend; |
838
|
|
|
|
|
|
|
return; |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
} |
841
|
|
|
|
|
|
|
push @{ $self->{qq_database}{friends} },$friend; |
842
|
|
|
|
|
|
|
return; |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
console "更新好友信息...\n"; |
845
|
|
|
|
|
|
|
my $friends_info = $self->_get_user_friends(); |
846
|
|
|
|
|
|
|
if(defined $friends_info){ |
847
|
|
|
|
|
|
|
$self->{qq_database}{friends} = $friends_info; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
else{console "更新好友信息失败\n";} |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
} |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
sub update_discuss_info { |
854
|
|
|
|
|
|
|
my $self = shift; |
855
|
|
|
|
|
|
|
my $discuss = shift; |
856
|
|
|
|
|
|
|
my $is_init = 1 if @{$self->{qq_database}{discuss}} == 0; |
857
|
|
|
|
|
|
|
if(defined $discuss){ |
858
|
|
|
|
|
|
|
for( @{$self->{qq_database}{discuss}} ){ |
859
|
|
|
|
|
|
|
if($_->{dinfo}{did} eq $discuss->{dinfo}{did} ){ |
860
|
|
|
|
|
|
|
$self->_detect_loss_discuss_member($_,$discuss); |
861
|
|
|
|
|
|
|
$self->_detect_new_discuss_member2($_,$discuss); |
862
|
|
|
|
|
|
|
$_ = $discuss; |
863
|
|
|
|
|
|
|
return; |
864
|
|
|
|
|
|
|
} |
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
push @{$self->{qq_database}{discuss}},$discuss; |
867
|
|
|
|
|
|
|
if(!$is_init and ref $self->{on_new_discuss} eq 'CODE'){ |
868
|
|
|
|
|
|
|
eval { |
869
|
|
|
|
|
|
|
$self->{on_new_discuss}->(dclone($discuss)); |
870
|
|
|
|
|
|
|
}; |
871
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
return; |
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
$self->update_discuss_list_info(); |
876
|
|
|
|
|
|
|
for my $dl (@{ $self->{qq_database}{discuss_list} }){ |
877
|
|
|
|
|
|
|
console "更新[ $dl->{name} ]讨论组信息...\n"; |
878
|
|
|
|
|
|
|
my $discuss_info = $self->_get_discuss_info($dl->{did}); |
879
|
|
|
|
|
|
|
if(defined $discuss_info){ |
880
|
|
|
|
|
|
|
if(ref $discuss_info->{minfo} ne 'ARRAY'){ |
881
|
|
|
|
|
|
|
console "更新[ $dl->{name} ]讨论组成功,但暂时没有获取到讨论组成员信息...\n"; |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
my $flag = 0; |
884
|
|
|
|
|
|
|
for( @{$self->{qq_database}{discuss}} ){ |
885
|
|
|
|
|
|
|
if($_->{dinfo}{did} eq $discuss_info->{dinfo}{did} ){ |
886
|
|
|
|
|
|
|
$self->_detect_loss_discuss_member($_,$discuss_info); |
887
|
|
|
|
|
|
|
$self->_detect_new_discuss_member2($_,$discuss_info); |
888
|
|
|
|
|
|
|
$_ = $discuss_info if ref $discuss_info->{minfo} eq 'ARRAY'; |
889
|
|
|
|
|
|
|
$flag = 1; |
890
|
|
|
|
|
|
|
last; |
891
|
|
|
|
|
|
|
} |
892
|
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
|
if($flag == 0){ |
894
|
|
|
|
|
|
|
push @{ $self->{qq_database}{discuss} }, $discuss_info; |
895
|
|
|
|
|
|
|
if( !$is_init and ref $self->{on_new_discuss} eq 'CODE'){ |
896
|
|
|
|
|
|
|
eval { |
897
|
|
|
|
|
|
|
$self->{on_new_discuss}->(dclone($discuss_info)); |
898
|
|
|
|
|
|
|
}; |
899
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
else{console "更新[ $dl->{name} ]讨论组信息失败\n";} |
905
|
|
|
|
|
|
|
} |
906
|
|
|
|
|
|
|
} |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
sub update_discuss_list_info { |
909
|
|
|
|
|
|
|
my $self = shift; |
910
|
|
|
|
|
|
|
my $discuss = shift; |
911
|
|
|
|
|
|
|
if(defined $discuss ){ |
912
|
|
|
|
|
|
|
for(@{ $self->{qq_database}{discuss_list} }){ |
913
|
|
|
|
|
|
|
if($_->{did} eq $discuss->{did}){ |
914
|
|
|
|
|
|
|
$_ = $discuss; |
915
|
|
|
|
|
|
|
return; |
916
|
|
|
|
|
|
|
} |
917
|
|
|
|
|
|
|
} |
918
|
|
|
|
|
|
|
push @{ $self->{qq_database}{discuss_list} }, $discuss; |
919
|
|
|
|
|
|
|
return; |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
console "更新讨论组列表信息...\n"; |
922
|
|
|
|
|
|
|
my $discuss_list_info = $self->_get_discuss_list_info(); |
923
|
|
|
|
|
|
|
if(defined $discuss_list_info){ |
924
|
|
|
|
|
|
|
$self->{qq_database}{discuss_list} = $discuss_list_info; |
925
|
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
else{console "更新讨论组列表信息失败\n";} |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
} |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
sub update_group_info{ |
931
|
|
|
|
|
|
|
my $self = shift; |
932
|
|
|
|
|
|
|
my $group = shift; |
933
|
|
|
|
|
|
|
my $is_init = 1 if @{$self->{qq_database}{group}} == 0; |
934
|
|
|
|
|
|
|
if(defined $group){ |
935
|
|
|
|
|
|
|
for( @{$self->{qq_database}{group}} ){ |
936
|
|
|
|
|
|
|
if($_->{ginfo}{code} eq $group->{ginfo}{code} ){ |
937
|
|
|
|
|
|
|
$self->_detect_loss_group_member($_,$group); |
938
|
|
|
|
|
|
|
$self->_detect_new_group_member2($_,$group); |
939
|
|
|
|
|
|
|
$_ = $group; |
940
|
|
|
|
|
|
|
return; |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
push @{$self->{qq_database}{group}},$group; |
944
|
|
|
|
|
|
|
if(!$is_init and ref $self->{on_new_group} eq 'CODE'){ |
945
|
|
|
|
|
|
|
eval { |
946
|
|
|
|
|
|
|
$self->{on_new_group}->(dclone($group)); |
947
|
|
|
|
|
|
|
}; |
948
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
949
|
|
|
|
|
|
|
} |
950
|
|
|
|
|
|
|
return; |
951
|
|
|
|
|
|
|
} |
952
|
|
|
|
|
|
|
$self->update_group_list_info(); |
953
|
|
|
|
|
|
|
for my $gl (@{ $self->{qq_database}{group_list} }){ |
954
|
|
|
|
|
|
|
console "更新[ $gl->{name} ]群信息...\n"; |
955
|
|
|
|
|
|
|
my $group_info = $self->_get_group_info($gl->{code}); |
956
|
|
|
|
|
|
|
if(defined $group_info){ |
957
|
|
|
|
|
|
|
if(ref $group_info->{minfo} ne 'ARRAY'){ |
958
|
|
|
|
|
|
|
console "更新[ $gl->{name} ]成功,但暂时没有获取到群成员信息...\n"; |
959
|
|
|
|
|
|
|
} |
960
|
|
|
|
|
|
|
my $flag = 0; |
961
|
|
|
|
|
|
|
for( @{$self->{qq_database}{group}} ){ |
962
|
|
|
|
|
|
|
if($_->{ginfo}{code} eq $group_info->{ginfo}{code} ){ |
963
|
|
|
|
|
|
|
$self->_detect_loss_group_member($_,$group_info); |
964
|
|
|
|
|
|
|
$self->_detect_new_group_member2($_,$group_info); |
965
|
|
|
|
|
|
|
$_ = $group_info if ref $group_info->{minfo} eq 'ARRAY'; |
966
|
|
|
|
|
|
|
$flag = 1; |
967
|
|
|
|
|
|
|
last; |
968
|
|
|
|
|
|
|
} |
969
|
|
|
|
|
|
|
} |
970
|
|
|
|
|
|
|
if($flag == 0){ |
971
|
|
|
|
|
|
|
push @{ $self->{qq_database}{group} }, $group_info; |
972
|
|
|
|
|
|
|
if( !$is_init and ref $self->{on_new_group} eq 'CODE'){ |
973
|
|
|
|
|
|
|
eval { |
974
|
|
|
|
|
|
|
$self->{on_new_group}->(dclone($group_info)); |
975
|
|
|
|
|
|
|
}; |
976
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
} |
979
|
|
|
|
|
|
|
} |
980
|
|
|
|
|
|
|
else{console "更新[ $gl->{name} ]群信息失败\n";} |
981
|
|
|
|
|
|
|
} |
982
|
|
|
|
|
|
|
} |
983
|
|
|
|
|
|
|
sub update_recent_info { |
984
|
|
|
|
|
|
|
my $self = shift; |
985
|
|
|
|
|
|
|
my $recent = $self->_get_recent_info(); |
986
|
|
|
|
|
|
|
$self->{qq_database}{recent} = $recent if defined $recent; |
987
|
|
|
|
|
|
|
} |
988
|
|
|
|
|
|
|
sub update_group_list_info{ |
989
|
|
|
|
|
|
|
my $self = shift; |
990
|
|
|
|
|
|
|
my $group = shift; |
991
|
|
|
|
|
|
|
if(defined $group ){ |
992
|
|
|
|
|
|
|
for(@{ $self->{qq_database}{group_list} }){ |
993
|
|
|
|
|
|
|
if($_->{code} eq $group->{code}){ |
994
|
|
|
|
|
|
|
$_ = $group; |
995
|
|
|
|
|
|
|
return; |
996
|
|
|
|
|
|
|
} |
997
|
|
|
|
|
|
|
} |
998
|
|
|
|
|
|
|
push @{ $self->{qq_database}{group_list} }, $group; |
999
|
|
|
|
|
|
|
return; |
1000
|
|
|
|
|
|
|
} |
1001
|
|
|
|
|
|
|
console "更新群列表信息...\n"; |
1002
|
|
|
|
|
|
|
my $group_list_info = $self->_get_group_list_info(); |
1003
|
|
|
|
|
|
|
if(defined $group_list_info){ |
1004
|
|
|
|
|
|
|
$self->{qq_database}{group_list} = $group_list_info->{gnamelist}; |
1005
|
|
|
|
|
|
|
my %gmarklist; |
1006
|
|
|
|
|
|
|
for(@{ $group_list_info->{gmarklist} }){ |
1007
|
|
|
|
|
|
|
$gmarklist{$_->{uin}} = $_->{markname}; |
1008
|
|
|
|
|
|
|
} |
1009
|
|
|
|
|
|
|
for(@{ $self->{qq_database}{group_list} }){ |
1010
|
|
|
|
|
|
|
$_->{markname} = $gmarklist{$_->{gid}}; |
1011
|
|
|
|
|
|
|
$_->{name} = encode("utf8",$_->{name}); |
1012
|
|
|
|
|
|
|
} |
1013
|
|
|
|
|
|
|
} |
1014
|
|
|
|
|
|
|
#else{console "更新群列表信息失败\n";} |
1015
|
|
|
|
|
|
|
} |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
sub update_friend_state_info{ |
1018
|
|
|
|
|
|
|
my $self = shift; |
1019
|
|
|
|
|
|
|
my ($uin,$state,$client_type) = @_; |
1020
|
|
|
|
|
|
|
my $f = first {$_->{uin} eq $uin} @{$self->{qq_database}{friends}}; |
1021
|
|
|
|
|
|
|
if(defined $f){ |
1022
|
|
|
|
|
|
|
$f->{state} = $state; |
1023
|
|
|
|
|
|
|
$f->{client_type} = $client_type; |
1024
|
|
|
|
|
|
|
return dclone($f); |
1025
|
|
|
|
|
|
|
} |
1026
|
|
|
|
|
|
|
return undef; |
1027
|
|
|
|
|
|
|
} |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
sub get_group_code_from_gid { |
1030
|
|
|
|
|
|
|
my $self = shift; |
1031
|
|
|
|
|
|
|
my $gid = shift; |
1032
|
|
|
|
|
|
|
my $group = first {$_->{gid} eq $gid} @{ $self->{qq_database}{group_list} }; |
1033
|
|
|
|
|
|
|
return defined $group?$group->{code}:undef; |
1034
|
|
|
|
|
|
|
} |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
sub _detect_new_friend{ |
1037
|
|
|
|
|
|
|
my $self = shift; |
1038
|
|
|
|
|
|
|
my $uin = shift; |
1039
|
|
|
|
|
|
|
return if defined $self->search_friend($uin); |
1040
|
|
|
|
|
|
|
#新增好友 |
1041
|
|
|
|
|
|
|
my $friend = $self->_get_friend_info($uin); |
1042
|
|
|
|
|
|
|
if(defined $friend){ |
1043
|
|
|
|
|
|
|
$self->{cache_for_friend}->store($uin,$friend); |
1044
|
|
|
|
|
|
|
push @{ $self->{qq_database}{friends} },$friend; |
1045
|
|
|
|
|
|
|
if(ref $self->{on_new_friend} eq 'CODE'){ |
1046
|
|
|
|
|
|
|
eval{ |
1047
|
|
|
|
|
|
|
$self->{on_new_friend}->($friend); |
1048
|
|
|
|
|
|
|
}; |
1049
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
1050
|
|
|
|
|
|
|
} |
1051
|
|
|
|
|
|
|
return ; |
1052
|
|
|
|
|
|
|
} |
1053
|
|
|
|
|
|
|
#新增陌生好友(你是对方好友,但对方还不是你好友) |
1054
|
|
|
|
|
|
|
else{ |
1055
|
|
|
|
|
|
|
my $default_friend = { |
1056
|
|
|
|
|
|
|
uin => $uin, |
1057
|
|
|
|
|
|
|
categories => "陌生人", |
1058
|
|
|
|
|
|
|
nick => undef, |
1059
|
|
|
|
|
|
|
}; |
1060
|
|
|
|
|
|
|
push @{ $self->{qq_database}{friends} },$default_friend; |
1061
|
|
|
|
|
|
|
return ; |
1062
|
|
|
|
|
|
|
} |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
} |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
sub _detect_new_group{ |
1067
|
|
|
|
|
|
|
my $self = shift; |
1068
|
|
|
|
|
|
|
my $gcode = shift; |
1069
|
|
|
|
|
|
|
return if defined $self->search_group($gcode); |
1070
|
|
|
|
|
|
|
my $group_info = $self->_get_group_info($gcode); |
1071
|
|
|
|
|
|
|
if(defined $group_info ){ |
1072
|
|
|
|
|
|
|
$self->update_group_list_info({ |
1073
|
|
|
|
|
|
|
name => $group_info->{ginfo}{name}, |
1074
|
|
|
|
|
|
|
gid => $group_info->{ginfo}{gid}, |
1075
|
|
|
|
|
|
|
code => $group_info->{ginfo}{code}, |
1076
|
|
|
|
|
|
|
}); |
1077
|
|
|
|
|
|
|
push @{$self->{qq_database}{group}},$group_info; |
1078
|
|
|
|
|
|
|
if(ref $self->{on_new_group} eq 'CODE'){ |
1079
|
|
|
|
|
|
|
eval{ |
1080
|
|
|
|
|
|
|
$self->{on_new_group}->(dclone($group_info)); |
1081
|
|
|
|
|
|
|
}; |
1082
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
return ; |
1085
|
|
|
|
|
|
|
} |
1086
|
|
|
|
|
|
|
else{ |
1087
|
|
|
|
|
|
|
return ; |
1088
|
|
|
|
|
|
|
} |
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
sub _detect_new_group_member{ |
1092
|
|
|
|
|
|
|
my $self = shift; |
1093
|
|
|
|
|
|
|
my ($gcode,$member_uin) = @_; |
1094
|
|
|
|
|
|
|
my $default_member = { |
1095
|
|
|
|
|
|
|
nick => undef, |
1096
|
|
|
|
|
|
|
province => undef, |
1097
|
|
|
|
|
|
|
gender => undef, |
1098
|
|
|
|
|
|
|
uin => $member_uin, |
1099
|
|
|
|
|
|
|
country => undef, |
1100
|
|
|
|
|
|
|
city => undef, |
1101
|
|
|
|
|
|
|
card => undef, |
1102
|
|
|
|
|
|
|
}; |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
my $group = first {$_->{ginfo}{code} eq $gcode} @{$self->{qq_database}{group}}; |
1105
|
|
|
|
|
|
|
#群至少得存在 |
1106
|
|
|
|
|
|
|
return unless defined $group; |
1107
|
|
|
|
|
|
|
#如果包含群成员信息 |
1108
|
|
|
|
|
|
|
if(exists $group->{minfo}){ |
1109
|
|
|
|
|
|
|
return if defined $self->search_member_in_group($gcode,$member_uin); |
1110
|
|
|
|
|
|
|
#查不到成员信息,说明是新增的成员,重新更新一次群信息 |
1111
|
|
|
|
|
|
|
my $new_group_member = {}; |
1112
|
|
|
|
|
|
|
my $group_info = $self->_get_group_info($gcode); |
1113
|
|
|
|
|
|
|
#更新群信息成功 |
1114
|
|
|
|
|
|
|
if(defined $group_info and ref $group_info->{minfo} eq 'ARRAY'){ |
1115
|
|
|
|
|
|
|
#再次查找新增的成员 |
1116
|
|
|
|
|
|
|
my $m = first {$_->{uin} eq $member_uin} @{$group_info->{minfo}}; |
1117
|
|
|
|
|
|
|
if(defined $m){ |
1118
|
|
|
|
|
|
|
$self->{cache_for_group_member}->store("$gcode|$member_uin",dclone($m)); |
1119
|
|
|
|
|
|
|
$new_group_member = $m; |
1120
|
|
|
|
|
|
|
} |
1121
|
|
|
|
|
|
|
else{ |
1122
|
|
|
|
|
|
|
$new_group_member = $default_member; |
1123
|
|
|
|
|
|
|
} |
1124
|
|
|
|
|
|
|
} |
1125
|
|
|
|
|
|
|
#群成员信息更新失败 |
1126
|
|
|
|
|
|
|
else{ |
1127
|
|
|
|
|
|
|
$new_group_member = $default_member; |
1128
|
|
|
|
|
|
|
} |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
push @{$group->{minfo}},$new_group_member; |
1131
|
|
|
|
|
|
|
if(ref $self->{on_new_group_member} eq 'CODE'){ |
1132
|
|
|
|
|
|
|
eval{ |
1133
|
|
|
|
|
|
|
$self->{on_new_group_member}->(dclone($group),dclone($new_group_member)); |
1134
|
|
|
|
|
|
|
}; |
1135
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
1136
|
|
|
|
|
|
|
} |
1137
|
|
|
|
|
|
|
return; |
1138
|
|
|
|
|
|
|
} |
1139
|
|
|
|
|
|
|
else{ |
1140
|
|
|
|
|
|
|
return; |
1141
|
|
|
|
|
|
|
} |
1142
|
|
|
|
|
|
|
} |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
sub _detect_new_group_member2 { |
1145
|
|
|
|
|
|
|
my $self = shift; |
1146
|
|
|
|
|
|
|
my($group_old,$group_new) = @_; |
1147
|
|
|
|
|
|
|
return if ref $group_old->{minfo} ne 'ARRAY'; |
1148
|
|
|
|
|
|
|
return if ref $group_new->{minfo} ne 'ARRAY'; |
1149
|
|
|
|
|
|
|
my %e = map {$_->{uin} => undef} @{$group_old->{minfo}}; |
1150
|
|
|
|
|
|
|
for my $new (@{$group_new->{minfo}}){ |
1151
|
|
|
|
|
|
|
#旧的没有,新的有,说明是新增群成员 |
1152
|
|
|
|
|
|
|
unless(exists $e{$new->{uin}}){ |
1153
|
|
|
|
|
|
|
if(ref $self->{on_new_group_member} eq 'CODE'){ |
1154
|
|
|
|
|
|
|
eval{ |
1155
|
|
|
|
|
|
|
$self->{on_new_group_member}->(dclone($group_new),dclone($new)); |
1156
|
|
|
|
|
|
|
}; |
1157
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
1158
|
|
|
|
|
|
|
}; |
1159
|
|
|
|
|
|
|
} |
1160
|
|
|
|
|
|
|
} |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
} |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
sub _detect_loss_group_member { |
1165
|
|
|
|
|
|
|
my $self = shift; |
1166
|
|
|
|
|
|
|
my($group_old,$group_new) = @_; |
1167
|
|
|
|
|
|
|
return if ref $group_old->{minfo} ne 'ARRAY'; |
1168
|
|
|
|
|
|
|
return if ref $group_new->{minfo} ne 'ARRAY'; |
1169
|
|
|
|
|
|
|
my %e = map {$_->{uin} => undef} @{$group_new->{minfo}}; |
1170
|
|
|
|
|
|
|
for my $old (@{$group_old->{minfo}}){ |
1171
|
|
|
|
|
|
|
#旧的有,新的没有,说明是已经退群的成员 |
1172
|
|
|
|
|
|
|
unless(exists $e{$old->{uin}}){ |
1173
|
|
|
|
|
|
|
if(ref $self->{on_loss_group_member} eq 'CODE'){ |
1174
|
|
|
|
|
|
|
eval{ |
1175
|
|
|
|
|
|
|
$self->{on_loss_group_member}->(dclone($group_old),dclone($old)); |
1176
|
|
|
|
|
|
|
}; |
1177
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
1178
|
|
|
|
|
|
|
}; |
1179
|
|
|
|
|
|
|
} |
1180
|
|
|
|
|
|
|
$self->{cache_for_group_member}->delete($group_old->{ginfo}{code} . "|" . $old->{uin}); |
1181
|
|
|
|
|
|
|
} |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
} |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
sub _detect_new_discuss{ |
1186
|
|
|
|
|
|
|
my $self = shift; |
1187
|
|
|
|
|
|
|
my $did = shift; |
1188
|
|
|
|
|
|
|
return if defined $self->search_discuss($did); |
1189
|
|
|
|
|
|
|
my $discuss_info = $self->_get_discuss_info($did); |
1190
|
|
|
|
|
|
|
if(defined $discuss_info ){ |
1191
|
|
|
|
|
|
|
$self->update_discuss_list_info({ |
1192
|
|
|
|
|
|
|
name => $discuss_info->{dinfo}{name}, |
1193
|
|
|
|
|
|
|
did => $discuss_info->{dinfo}{did}, |
1194
|
|
|
|
|
|
|
}); |
1195
|
|
|
|
|
|
|
push @{$self->{qq_database}{discuss}},$discuss_info; |
1196
|
|
|
|
|
|
|
if(ref $self->{on_new_discuss} eq 'CODE'){ |
1197
|
|
|
|
|
|
|
eval{ |
1198
|
|
|
|
|
|
|
$self->{on_new_discuss}->(dclone($discuss_info)); |
1199
|
|
|
|
|
|
|
}; |
1200
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
1201
|
|
|
|
|
|
|
} |
1202
|
|
|
|
|
|
|
return ; |
1203
|
|
|
|
|
|
|
} |
1204
|
|
|
|
|
|
|
else{ |
1205
|
|
|
|
|
|
|
return ; |
1206
|
|
|
|
|
|
|
} |
1207
|
|
|
|
|
|
|
} |
1208
|
|
|
|
|
|
|
sub _detect_loss_discuss_member { |
1209
|
|
|
|
|
|
|
my $self = shift; |
1210
|
|
|
|
|
|
|
my($discuss_old,$discuss_new) = @_; |
1211
|
|
|
|
|
|
|
return if ref $discuss_old->{minfo} ne 'ARRAY'; |
1212
|
|
|
|
|
|
|
return if ref $discuss_new->{minfo} ne 'ARRAY'; |
1213
|
|
|
|
|
|
|
my %e = map {$_->{uin} => undef} @{$discuss_new->{minfo}}; |
1214
|
|
|
|
|
|
|
for my $old (@{$discuss_old->{minfo}}){ |
1215
|
|
|
|
|
|
|
#旧的有,新的没有,说明是已经退群的成员 |
1216
|
|
|
|
|
|
|
unless(exists $e{$old->{uin}}){ |
1217
|
|
|
|
|
|
|
if(ref $self->{on_loss_discuss_member} eq 'CODE'){ |
1218
|
|
|
|
|
|
|
eval{ |
1219
|
|
|
|
|
|
|
$self->{on_loss_discuss_member}->(dclone($discuss_old),dclone($old)); |
1220
|
|
|
|
|
|
|
}; |
1221
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
1222
|
|
|
|
|
|
|
}; |
1223
|
|
|
|
|
|
|
} |
1224
|
|
|
|
|
|
|
$self->{cache_for_discuss_member}->delete($discuss_old->{dinfo}{did} . "|" . $old->{uin}); |
1225
|
|
|
|
|
|
|
} |
1226
|
|
|
|
|
|
|
} |
1227
|
|
|
|
|
|
|
sub _detect_new_discuss_member { |
1228
|
|
|
|
|
|
|
my $self = shift; |
1229
|
|
|
|
|
|
|
my ($did,$member_uin) = @_; |
1230
|
|
|
|
|
|
|
my $default_member = { |
1231
|
|
|
|
|
|
|
nick => undef, |
1232
|
|
|
|
|
|
|
uin => $member_uin, |
1233
|
|
|
|
|
|
|
}; |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
my $discuss = first {$_->{dinfo}{did} eq $did} @{$self->{qq_database}{discuss} }; |
1236
|
|
|
|
|
|
|
#群至少得存在 |
1237
|
|
|
|
|
|
|
return unless defined $discuss; |
1238
|
|
|
|
|
|
|
#如果包含成员信息 |
1239
|
|
|
|
|
|
|
if(exists $discuss->{minfo}){ |
1240
|
|
|
|
|
|
|
return if defined $self->search_member_in_discuss($did,$member_uin); |
1241
|
|
|
|
|
|
|
#查不到成员信息,说明是新增的成员,重新更新一次群信息 |
1242
|
|
|
|
|
|
|
my $new_discuss_member = {}; |
1243
|
|
|
|
|
|
|
my $discuss_info = $self->_get_discuss_info($did); |
1244
|
|
|
|
|
|
|
#更新群信息成功 |
1245
|
|
|
|
|
|
|
if(defined $discuss_info and ref $discuss_info->{minfo} eq 'ARRAY'){ |
1246
|
|
|
|
|
|
|
#再次查找新增的成员 |
1247
|
|
|
|
|
|
|
my $m = first {$_->{uin} eq $member_uin} @{$discuss_info->{minfo}}; |
1248
|
|
|
|
|
|
|
if(defined $m){ |
1249
|
|
|
|
|
|
|
$self->{cache_for_discuss_member}->store("$did|$member_uin",dclone($m)); |
1250
|
|
|
|
|
|
|
$new_discuss_member = $m; |
1251
|
|
|
|
|
|
|
} |
1252
|
|
|
|
|
|
|
else{ |
1253
|
|
|
|
|
|
|
#仍然找不到信息,只好直接返回空了 |
1254
|
|
|
|
|
|
|
$new_discuss_member = $default_member; |
1255
|
|
|
|
|
|
|
} |
1256
|
|
|
|
|
|
|
} |
1257
|
|
|
|
|
|
|
#成员信息更新失败 |
1258
|
|
|
|
|
|
|
else{ |
1259
|
|
|
|
|
|
|
$new_discuss_member = $default_member; |
1260
|
|
|
|
|
|
|
} |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
push @{$discuss->{minfo}},$new_discuss_member; |
1263
|
|
|
|
|
|
|
if(ref $self->{on_new_discuss_member} eq 'CODE'){ |
1264
|
|
|
|
|
|
|
eval{ |
1265
|
|
|
|
|
|
|
$self->{on_new_discuss_member}->(dclone($discuss),dclone($new_discuss_member)); |
1266
|
|
|
|
|
|
|
}; |
1267
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
1268
|
|
|
|
|
|
|
} |
1269
|
|
|
|
|
|
|
return; |
1270
|
|
|
|
|
|
|
} |
1271
|
|
|
|
|
|
|
else{ |
1272
|
|
|
|
|
|
|
return; |
1273
|
|
|
|
|
|
|
} |
1274
|
|
|
|
|
|
|
} |
1275
|
|
|
|
|
|
|
sub _detect_new_discuss_member2 { |
1276
|
|
|
|
|
|
|
my $self = shift; |
1277
|
|
|
|
|
|
|
my($discuss_old,$discuss_new) = @_; |
1278
|
|
|
|
|
|
|
return if ref $discuss_old->{minfo} ne 'ARRAY'; |
1279
|
|
|
|
|
|
|
return if ref $discuss_new->{minfo} ne 'ARRAY'; |
1280
|
|
|
|
|
|
|
my %e = map {$_->{uin} => undef} @{$discuss_old->{minfo}}; |
1281
|
|
|
|
|
|
|
for my $new (@{$discuss_new->{minfo}}){ |
1282
|
|
|
|
|
|
|
#旧的没有,新的有,说明是新增群成员 |
1283
|
|
|
|
|
|
|
unless(exists $e{$new->{uin}}){ |
1284
|
|
|
|
|
|
|
if(ref $self->{on_new_discuss_member} eq 'CODE'){ |
1285
|
|
|
|
|
|
|
eval{ |
1286
|
|
|
|
|
|
|
$self->{on_new_discuss_member}->(dclone($discuss_new),dclone($new)); |
1287
|
|
|
|
|
|
|
}; |
1288
|
|
|
|
|
|
|
console $@ . "\n" if $@; |
1289
|
|
|
|
|
|
|
}; |
1290
|
|
|
|
|
|
|
} |
1291
|
|
|
|
|
|
|
} |
1292
|
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
sub _update_extra_info{ |
1295
|
|
|
|
|
|
|
my $self = shift; |
1296
|
|
|
|
|
|
|
my %p = @_; |
1297
|
|
|
|
|
|
|
$p{type} = "all" unless defined $p{type}; |
1298
|
|
|
|
|
|
|
eval{require Webqq::Qun;}; |
1299
|
|
|
|
|
|
|
if($@){ |
1300
|
|
|
|
|
|
|
console "Webqq::Qun模块未找到,已忽略相关功能\n" if $self->{debug}; |
1301
|
|
|
|
|
|
|
return; |
1302
|
|
|
|
|
|
|
} |
1303
|
|
|
|
|
|
|
eval{ |
1304
|
|
|
|
|
|
|
my $qun = Webqq::Qun->new(qq=>$self->{qq_param}{qq},pwd=>$self->{qq_param}{pwd},debug=>$self->{debug}); |
1305
|
|
|
|
|
|
|
$qun->authorize() or die "authorize fail\n"; |
1306
|
|
|
|
|
|
|
if($p{type} eq "all"){ |
1307
|
|
|
|
|
|
|
$qun->get_friend(); |
1308
|
|
|
|
|
|
|
$qun->get_qun(); |
1309
|
|
|
|
|
|
|
$self->{extra_qq_database} = { |
1310
|
|
|
|
|
|
|
friends => $qun->{friend}, |
1311
|
|
|
|
|
|
|
group => $qun->{data}, |
1312
|
|
|
|
|
|
|
}; |
1313
|
|
|
|
|
|
|
$self->_update_extra_friend_info(); |
1314
|
|
|
|
|
|
|
$self->_update_extra_group_info(); |
1315
|
|
|
|
|
|
|
} |
1316
|
|
|
|
|
|
|
elsif($p{type} eq "friend"){ |
1317
|
|
|
|
|
|
|
$qun->get_friend(); |
1318
|
|
|
|
|
|
|
$self->{extra_qq_database} = { |
1319
|
|
|
|
|
|
|
friends => $qun->{friend}, |
1320
|
|
|
|
|
|
|
}; |
1321
|
|
|
|
|
|
|
$self->_update_extra_friend_info(); |
1322
|
|
|
|
|
|
|
} |
1323
|
|
|
|
|
|
|
elsif($p{type} eq "group"){ |
1324
|
|
|
|
|
|
|
$qun->get_qun(); |
1325
|
|
|
|
|
|
|
$self->{extra_qq_database} = { |
1326
|
|
|
|
|
|
|
group => $qun->{data}, |
1327
|
|
|
|
|
|
|
}; |
1328
|
|
|
|
|
|
|
$self->_update_extra_group_info(); |
1329
|
|
|
|
|
|
|
} |
1330
|
|
|
|
|
|
|
}; |
1331
|
|
|
|
|
|
|
if($@){ |
1332
|
|
|
|
|
|
|
console "Webqq::Qun模块执行失败:$@\n" if $self->{debug}; |
1333
|
|
|
|
|
|
|
return; |
1334
|
|
|
|
|
|
|
} |
1335
|
|
|
|
|
|
|
return 1; |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
} |
1338
|
|
|
|
|
|
|
sub _update_extra_friend_info{ |
1339
|
|
|
|
|
|
|
my $self = shift; |
1340
|
|
|
|
|
|
|
return unless defined $self->{extra_qq_database}{friends}; |
1341
|
|
|
|
|
|
|
my %map; |
1342
|
|
|
|
|
|
|
my %map_ignore; |
1343
|
|
|
|
|
|
|
for (@{$self->{extra_qq_database}{friends}}){ |
1344
|
|
|
|
|
|
|
next if exists $map_ignore{$_->{nick}}; |
1345
|
|
|
|
|
|
|
$map_ignore{$_->{nick}} = 1; |
1346
|
|
|
|
|
|
|
$map{$_->{nick}} = $_->{qq} ; |
1347
|
|
|
|
|
|
|
} |
1348
|
|
|
|
|
|
|
for(@{$self->{qq_database}{friends}}){ |
1349
|
|
|
|
|
|
|
$_->{qq} = $map{$_->{nick}} if exists $map{$_->{nick}}; |
1350
|
|
|
|
|
|
|
$self->{cache_for_qq_to_uin}->store($_->{qq},$_->{uin}); |
1351
|
|
|
|
|
|
|
$self->{cache_for_uin_to_qq}->store($_->{uin},$_->{qq}); |
1352
|
|
|
|
|
|
|
} |
1353
|
|
|
|
|
|
|
return 1; |
1354
|
|
|
|
|
|
|
} |
1355
|
|
|
|
|
|
|
sub _update_extra_group_info{ |
1356
|
|
|
|
|
|
|
my $self = shift; |
1357
|
|
|
|
|
|
|
return unless defined $self->{extra_qq_database}{group}; |
1358
|
|
|
|
|
|
|
my %map_group; |
1359
|
|
|
|
|
|
|
my %map_group_ignore; |
1360
|
|
|
|
|
|
|
my %map_member; |
1361
|
|
|
|
|
|
|
my %map_member_ignore; |
1362
|
|
|
|
|
|
|
my @members; |
1363
|
|
|
|
|
|
|
for (@{$self->{extra_qq_database}{group}}){ |
1364
|
|
|
|
|
|
|
next if exists $map_group_ignore{$_->{qun_name}}; |
1365
|
|
|
|
|
|
|
$map_group_ignore{$_->{qun_name}} = 1; |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
push @members,@{$_->{members}} ; |
1368
|
|
|
|
|
|
|
$map_group{$_->{qun_name}}{number} = $_->{qun_number}; |
1369
|
|
|
|
|
|
|
$map_group{$_->{qun_name}}{type} = $_->{qun_type}; |
1370
|
|
|
|
|
|
|
} |
1371
|
|
|
|
|
|
|
for(@members){ |
1372
|
|
|
|
|
|
|
next if exists $map_member_ignore{$_->{qun_name},$_->{nick}}; |
1373
|
|
|
|
|
|
|
$map_member_ignore{$_->{qun_name},$_->{nick}} = 1; |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
$map_member{$_->{qun_name},$_->{nick}}{_count}++; |
1376
|
|
|
|
|
|
|
$map_member{$_->{qun_name},$_->{nick}}{qq} = $_->{qq}; |
1377
|
|
|
|
|
|
|
$map_member{$_->{qun_name},$_->{nick}}{qage} = $_->{qage}; |
1378
|
|
|
|
|
|
|
$map_member{$_->{qun_name},$_->{nick}}{join_time} = $_->{join_time}; |
1379
|
|
|
|
|
|
|
$map_member{$_->{qun_name},$_->{nick}}{last_speak_time} = $_->{last_speak_time}; |
1380
|
|
|
|
|
|
|
$map_member{$_->{qun_name},$_->{nick}}{level} = $_->{level}; |
1381
|
|
|
|
|
|
|
$map_member{$_->{qun_name},$_->{nick}}{role} = $_->{role}; |
1382
|
|
|
|
|
|
|
$map_member{$_->{qun_name},$_->{nick}}{bad_record} = $_->{bad_record}; |
1383
|
|
|
|
|
|
|
} |
1384
|
|
|
|
|
|
|
for(@{$self->{qq_database}{group_list}}){ |
1385
|
|
|
|
|
|
|
if(exists $map_group{$_->{name}}){ |
1386
|
|
|
|
|
|
|
$_->{number} = $map_group{$_->{name}}{number}; |
1387
|
|
|
|
|
|
|
$_->{type} = $map_group{$_->{name}}{type} ; |
1388
|
|
|
|
|
|
|
$self->{cache_for_number_to_uin}->store($_->{number},$_->{gid}); |
1389
|
|
|
|
|
|
|
$self->{cache_for_uin_to_number}->store($_->{gid},$_->{number}); |
1390
|
|
|
|
|
|
|
} |
1391
|
|
|
|
|
|
|
} |
1392
|
|
|
|
|
|
|
for(@{$self->{qq_database}{group}}){ |
1393
|
|
|
|
|
|
|
$_->{ginfo}{number} = $map_group{$_->{ginfo}{name}}{number} if exists $map_group{$_->{ginfo}{name}}{number}; |
1394
|
|
|
|
|
|
|
$_->{ginfo}{type} = $map_group{$_->{ginfo}{name}}{type} if exists $map_group{$_->{ginfo}{name}}{type}; |
1395
|
|
|
|
|
|
|
next unless ref $_->{minfo} eq 'ARRAY'; |
1396
|
|
|
|
|
|
|
for my $m (@{$_->{minfo}}){ |
1397
|
|
|
|
|
|
|
if(exists $map_member{$_->{ginfo}{name},$m->{nick}}){ |
1398
|
|
|
|
|
|
|
$m->{qq} = $map_member{$_->{ginfo}{name},$m->{nick}}{qq} ; |
1399
|
|
|
|
|
|
|
$m->{qage} = $map_member{$_->{ginfo}{name},$m->{nick}}{qage} ; |
1400
|
|
|
|
|
|
|
$m->{join_time} = $map_member{$_->{ginfo}{name},$m->{nick}}{join_time} ; |
1401
|
|
|
|
|
|
|
$m->{last_speak_time} = $map_member{$_->{ginfo}{name},$m->{nick}}{last_speak_time} ; |
1402
|
|
|
|
|
|
|
$m->{level} = $map_member{$_->{ginfo}{name},$m->{nick}}{level} ; |
1403
|
|
|
|
|
|
|
$m->{role} = $map_member{$_->{ginfo}{name},$m->{nick}}{role} ; |
1404
|
|
|
|
|
|
|
$m->{bad_record} = $map_member{$_->{ginfo}{name},$m->{nick}}{bad_record} ; |
1405
|
|
|
|
|
|
|
$self->{cache_for_uin_to_qq}->store($m->{uin},$m->{qq}); |
1406
|
|
|
|
|
|
|
$self->{cache_for_qq_to_uin}->store($m->{qq},$m->{uin}); |
1407
|
|
|
|
|
|
|
} |
1408
|
|
|
|
|
|
|
} |
1409
|
|
|
|
|
|
|
} |
1410
|
|
|
|
|
|
|
} |
1411
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
sub get_uin_from_qq{ |
1413
|
|
|
|
|
|
|
my $self = shift; |
1414
|
|
|
|
|
|
|
my $qq = shift; |
1415
|
|
|
|
|
|
|
return $self->{cache_for_qq_to_uin}->retrieve($qq); |
1416
|
|
|
|
|
|
|
} |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
sub get_uin_from_number { |
1419
|
|
|
|
|
|
|
my $self = shift; |
1420
|
|
|
|
|
|
|
my $number = shift; |
1421
|
|
|
|
|
|
|
return $self->{cache_for_number_to_uin}->retrieve($number); |
1422
|
|
|
|
|
|
|
} |
1423
|
|
|
|
|
|
|
sub get_number_from_uin { |
1424
|
|
|
|
|
|
|
my $self = shift; |
1425
|
|
|
|
|
|
|
my $uin = shift; |
1426
|
|
|
|
|
|
|
return $self->{cache_for_uin_to_number}->retrieve($uin); |
1427
|
|
|
|
|
|
|
} |
1428
|
|
|
|
|
|
|
1; |
1429
|
|
|
|
|
|
|
__END__ |