File Coverage

blib/lib/Webqq/Client.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


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__