File Coverage

blib/lib/Webqq/Client/Method/_get_discuss_info.pm
Criterion Covered Total %
statement 9 53 16.9
branch 0 18 0.0
condition 0 3 0.0
subroutine 3 4 75.0
pod n/a
total 12 78 15.3


line stmt bran cond sub pod time code
1 1     1   3 use JSON;
  1         1  
  1         4  
2 1     1   77 use Encode;
  1         2  
  1         46  
3 1     1   4 use Webqq::Client::Util qw(code2client);
  1         2  
  1         420  
4             sub Webqq::Client::_get_discuss_info {
5 0     0     my $self = shift;
6 0           my $ua = $self->{ua};
7 0           my $did = shift;
8 0 0         return undef if $self->{type} ne 'smartqq';
9 0           my $api_url = 'http://d.web2.qq.com/channel/get_discu_info';
10 0           my @query_string = (
11             did => $did,
12             vfwebqq => $self->{qq_param}{vfwebqq},
13             clientid => $self->{qq_param}{clientid},
14             psessionid => $self->{qq_param}{psessionid},
15             t => time(),
16             );
17 0           my @headers = (
18             Referer => 'http://d.web2.qq.com/proxy.html?v=20130916001&callback=1&id=2',
19             );
20              
21 0           my @query_string_pairs;
22 0           push @query_string_pairs , shift(@query_string) . "=" . shift(@query_string) while(@query_string);
23 0           my $response = $ua->get($api_url.'?'.join("&",@query_string_pairs),@headers);
24              
25 0 0         if($response->is_success){
  0            
26 0 0         print $response->content,"\n" if $self->{debug};
27 0           my $json;
28 0           eval{
29             #my $d = $response->content();
30             #$d=~s/\\u([a-zA-Z0-9]{4})/encode("utf8",eval qq#"\\x{$1}"#)/eg;
31             #print $d,"\n" if $self->{debug};
32 0           $json = JSON->new->utf8->decode($response->content());
33             };
34 0 0 0       print $@ if $@ and $self->{debug};
35 0 0         $json = {} unless defined $json;
36 0 0         return undef if $json->{retcode}!=0;
37 0 0         return undef unless exists $json->{result}{info};
38            
39 0           my %mem_list;
40             my %mem_status;
41 0           my %mem_info;
42 0           my $minfo = [];
43              
44 0           for(@{ $json->{result}{info}{mem_list} }){
  0            
45 0           $mem_list{$_->{mem_uin}}{ruin} = $_->{ruin};
46             }
47              
48 0           for(@{ $json->{result}{mem_status} }){
  0            
49 0           $mem_status{$_->{uin}}{status} = $_->{status};
50 0           $mem_status{$_->{uin}}{client_type} = $_->{client_type};
51             }
52              
53 0           for(@{ $json->{result}{mem_info} }){
  0            
54 0           $mem_info{$_->{uin}}{nick} = encode("utf8",$_->{nick});
55             }
56              
57 0           for(keys %mem_list){
58 0           my $m = {
59             uin => $_,
60             nick => $mem_info{$_}{nick},
61             ruin => $mem_list{$_}{ruin},
62             };
63 0 0         if(exists $mem_status{$_}){
64 0           $m->{state} = $mem_status{$_}{status};
65 0           $m->{client_type} = code2client($mem_status{$_}{client_type});
66             }
67             else{
68 0           $m->{state} = 'offline';
69 0           $m->{client_type} = 'unknown';
70             }
71 0           push @{$minfo},$m;
  0            
72             }
73              
74 0 0         my $discuss_info = {
75             dinfo => {
76             did => $json->{result}{info}{did},
77             owner => $json->{result}{info}{discu_owner},
78             name => encode("utf8",$json->{result}{info}{discu_name}),
79             info_seq => $json->{result}{info}{info_seq},
80             },
81             minfo => (@$minfo>0?$minfo:undef),
82             } ;
83 0           return $discuss_info;
84             }
85             else{return undef;}
86              
87             }
88             1;