File Coverage

blib/lib/Mojo/Webqq/Message/Base.pm
Criterion Covered Total %
statement 12 114 10.5
branch 0 78 0.0
condition 0 27 0.0
subroutine 4 16 25.0
pod 0 11 0.0
total 16 246 6.5


line stmt bran cond sub pod time code
1             package Mojo::Webqq::Message::Base;
2 1     1   7 use Mojo::Webqq::Base -base;
  1         2  
  1         10  
3 1     1   7 use Data::Dumper;
  1         4  
  1         52  
4 1     1   6 use Scalar::Util qw(blessed);
  1         3  
  1         56  
5 1     1   6 use List::Util qw(first);
  1         2  
  1         1896  
6             sub client {
7 0     0 0   return $Mojo::Webqq::_CLIENT;
8             }
9             sub dump{
10 0     0 0   my $self = shift;
11 0           my $clone = {};
12 0           my $obj_name = blessed($self);
13 0           for(keys %$self){
14 0 0 0       if(my $n=blessed($self->{$_})){
    0          
15 0           $clone->{$_} = "Object($n)";
16             }
17             elsif($_ eq "member" and ref($self->{$_}) eq "ARRAY"){
18 0           my $member_count = @{$self->{$_}};
  0            
19 0           $clone->{$_} = [ "$member_count of Object(${obj_name}::Member)" ];
20             }
21             else{
22 0           $clone->{$_} = $self->{$_};
23             }
24             }
25 0           local $Data::Dumper::Indent = 1;
26 0           local $Data::Dumper::Terse = 1;
27 0           $self->client->print("Object($obj_name) " . Data::Dumper::Dumper($clone));
28 0           return $self;
29             }
30              
31             sub is_at{
32 0     0 0   my $self = shift;
33 0 0         return if not $self->content;
34 0           my $object;
35             my $displayname;
36 0 0         if($self->class eq "recv"){
    0          
37 0   0       $object = shift || $self->receiver;
38 0           $displayname = $object->displayname;
39             }
40             elsif($self->class eq "send"){
41 0 0         if($self->type eq "group"){
    0          
    0          
42 0   0       $object = shift || $self->group->me;
43 0           $displayname = $object->displayname;
44             }
45             elsif($self->type eq "discuss"){
46 0   0       $object = shift || $self->discuss->me;
47 0           $displayname = $object->displayname;
48             }
49             elsif($self->type=~/^friend_message|sess_message$/){
50 0   0       $object = shift || $self->receiver;
51 0           $displayname = $object->displayname;
52             }
53             }
54 0 0         return if not $displayname;
55 0           return $self->content =~/\@\Q$displayname\E /;
56             }
57              
58             sub to_json_hash{
59 0     0 0   my $self = shift;
60 0           my $json = {};
61 0           for my $key (keys %$self){
62 0 0         next if substr($key,0,1) eq "_";
63 0 0         if($key eq "sender"){
    0          
    0          
    0          
    0          
64 0           $json->{sender} = $self->sender->displayname;
65 0           $json->{sender_uid} = $self->sender->uid;
66             }
67             elsif($key eq "receiver"){
68 0           $json->{receiver} = $self->receiver->displayname;
69 0           $json->{receiver_uid} = $self->receiver->uid;
70             }
71             elsif($key eq "group"){
72 0           $json->{group} = $self->group->displayname;
73 0           $json->{group_uid} = $self->group->uid;
74             }
75             elsif($key eq "discuss"){
76 0           $json->{discuss} = $self->discuss->displayname;
77             }
78             elsif(ref $self->{$key} eq ""){
79 0           $json->{$key} = $self->{$key};
80             }
81             }
82 0           return $json;
83             }
84              
85             sub text {
86 0     0 0   my $self = shift;
87 0 0         return $self->content if ref $self->raw_content ne "ARRAY";
88 0           return join "",map{$_->{content}} grep {$_->{type} eq "txt"} @{$self->{raw_content}};
  0            
  0            
  0            
89             }
90              
91             sub faces {
92 0     0 0   my $self = shift;
93 0 0         return if ref $self->raw_content ne "ARRAY";
94 0 0         if(wantarray){
95 0 0         return map {$_->{content}} grep {$_->{type} eq "face" or $_->{type} eq "emoji"} @{$self->{raw_content}};
  0            
  0            
  0            
96             }
97             else{
98 0 0         my @tmp = map {$_->{content}} grep {$_->{type} eq "face" or $_->{type} eq "emoji"} @{$self->{raw_content}};
  0            
  0            
  0            
99 0           return \@tmp;
100             }
101             }
102             sub images {
103 0     0 0   my $self = shift;
104 0           my $cb = shift;
105 0 0         $self->client->die("参数必须是一个函数引用") if ref $cb ne "CODE";
106 0 0         return if ref $self->raw_content ne "ARRAY";
107 0 0         return if $self->msg_class ne "recv";
108 0 0         return if $self->type eq "discuss_message";
109 0 0         for ( grep {$_->{type} eq "cface" or $_->{type} eq "offpic"} @{$self->raw_content}){
  0            
  0            
110 0 0         if($_->{type} eq "cface"){
    0          
111 0 0         return unless exists $_->{server};
112 0 0         return unless exists $_->{file_id};
113 0 0         return unless exists $_->{name};
114 0           my ($ip,$port) = split /:/,$_->{server};
115 0 0         $port = 80 unless defined $port;
116 0           $self->client->_get_group_pic($_->{file_id},$_->{name},$ip,$port,$self->sender,$cb);
117             }
118             elsif($_->{type} eq "offpic"){
119 0           $self->client->_get_offpic($_->{file_path},$self->sender,$cb);
120             }
121             }
122             }
123              
124              
125             sub reply {
126 0     0 0   my $self = shift;
127 0           $self->client->reply_message($self,@_);
128             }
129              
130             sub is_success{
131 0     0 0   my $self = shift;
132 0 0         return $self->code == 0?1:0;
133             }
134              
135             sub parse_send_status_msg{
136 0     0 0   my $self = shift;
137 0           my $json = shift;
138 0 0         if(defined $json){
139 0 0         if(exists $json->{errCode}){
    0          
140 0 0 0       if($json->{errCode}==0 and exists $json->{msg} and $json->{msg} eq 'send ok'){
    0 0        
      0        
141 0           $self->send_status(code=>0,msg=>"发送成功",info=>'发送正常');
142             }
143             elsif(exists $json->{errMsg} and $json->{errMsg} eq "ERROR"){
144 0           $self->send_status(code=>-3,msg=>"发送失败",info=>'发送异常');
145             }
146             else{
147 0           $self->send_status(code=>-4,msg=>"发送失败",info=>'响应未知: ' . $self->client->to_json($json));
148             }
149             }
150             elsif(exists $json->{retcode}){
151 0 0 0       if($json->{retcode}==0){
    0          
152 0           $self->send_status(code=>0,msg=>"发送成功",info=>'发送正常');
153             }
154 0     0     elsif( ref $self->client->ignore_send_retcode eq "ARRAY" and first { $json->{retcode} == $_ } @{$self->client->ignore_send_retcode} ){
  0            
155 0           $self->send_status(code=>0,msg=>"发送成功",info=>"忽略返回值: $json->{retcode}");
156             }
157             else{
158 0           $self->send_status(code=>-5,msg=>"发送失败",info=>'未识别返回值:' . $json->{retcode});
159             }
160             }
161             else{
162 0           $self->send_status(code=>-2,msg=>"发送失败",info=>'响应未知: ' . $self->cient->to_json($json));
163             }
164             }
165             else{
166 0           $self->send_status(code=>-1,msg=>"发送失败",info=>'数据格式错误');
167             }
168             }
169              
170             sub send_status{
171 0     0 0   my $self = shift;
172 0           my %opt = @_;
173 0           $self->code($opt{code})->msg($opt{msg})->info($opt{info});
174             }
175             1;