| 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__ |