File Coverage

blib/lib/Mojo/Weixin/Util.pm
Criterion Covered Total %
statement 21 223 9.4
branch 0 96 0.0
condition 0 60 0.0
subroutine 7 34 20.5
pod 0 26 0.0
total 28 439 6.3


line stmt bran cond sub pod time code
1             package Mojo::Weixin::Util;
2 1     1   7 use Carp qw();
  1         11  
  1         17  
3 1     1   4 use Encode ();
  1         2  
  1         12  
4 1     1   12 use IO::Handle;
  1         2  
  1         34  
5 1     1   5 use Mojo::Util ();
  1         1  
  1         21  
6 1     1   385 use Mojo::JSON qw();
  1         18224  
  1         29  
7 1     1   381 use Mojo::Weixin::Const qw(%FACE_MAP_QQ %FACE_MAP_EMOJI);
  1         3  
  1         227  
8             my %emoji_to_text_map = reverse %FACE_MAP_EMOJI;
9             sub emoji_convert {
10 0     0 0   my $self = shift;
11 0           my $content_ref = shift;
12 0 0         return $self if not $$content_ref;
13 0 0         my $is_emoji_to_text = shift; $is_emoji_to_text = 1 if not defined $is_emoji_to_text;
  0            
14 0 0         if($is_emoji_to_text){
15 0 0         $$content_ref=~s/<\/span>/exists $emoji_to_text_map{$1}?"[$emoji_to_text_map{$1}]":"[未知表情]"/ge;
  0            
16             }
17             else{
18 1     1   478 use bigint;
  1         2674  
  1         4  
19 0           $$content_ref=~s/<\/span>/$self->encode_utf8(chr(hex($1)))/ge;
  0            
20             }
21 0           return $self;
22             }
23             sub now {
24 0     0 0   my $self = shift;
25 0           return int Time::HiRes::time() * 1000;
26             }
27             sub encode{
28 0     0 0   my $self = shift;
29 0           return Mojo::Util::encode(@_);
30             }
31             sub decode{
32 0     0 0   my $self = shift;
33 0           return Mojo::Util::decode(@_);
34             }
35             sub encode_utf8{
36 0     0 0   my $self = shift;
37 0           return Mojo::Util::encode("utf8",@_);
38             }
39             sub url_escape{
40 0     0 0   my $self = shift;
41 0           return Mojo::Util::url_escape(@_);
42             }
43             sub b64_encode {
44 0     0 0   my $self = shift;
45 0           return Mojo::Util::b64_encode(@_);
46             }
47             sub slurp {
48 0     0 0   my $self = shift;
49 0           my $path = shift;
50              
51 0 0         open my $file, '<', $path or Carp::croak qq{Can't open file "$path": $!};
52 0           my $ret = my $content = '';
53 0           while ($ret = $file->sysread(my $buffer, 131072, 0)) { $content .= $buffer }
  0            
54 0 0         Carp::croak qq{Can't read from file "$path": $!} unless defined $ret;
55              
56 0           return $content;
57             }
58             sub spurt {
59 0     0 0   my $self = shift;
60 0           my ($content, $path) = @_;
61 0 0         open my $file, '>', $path or Carp::croak qq{Can't open file "$path": $!};
62 0 0         defined $file->syswrite($content)
63             or Carp::croak qq{Can't write to file "$path": $!};
64 0           return $content;
65             }
66             sub from_json{
67 0     0 0   my $self = shift;
68 0           my $r = eval{
69 0 0         if($self->json_codec_mode == 0){
    0          
70 0           my $json = Mojo::JSON::from_json(@_);
71 0           $json;
72             }
73             elsif($self->json_codec_mode == 1){
74 0           my $json = Mojo::JSON::decode_json(@_);
75 0           $self->reform($json);
76 0           $json;
77             }
78             else{
79 0           my $json = Mojo::JSON::from_json(@_);
80 0           $json;
81             }
82             };
83 0 0         if($@){
84 0           $self->warn($@);
85 0           $self->warn(__PACKAGE__ . "::from_json return undef value");
86 0           return undef;
87             }
88             else{
89 0 0         $self->warn(__PACKAGE__ . "::from_json return undef value") if not defined $r;
90 0           return $r;
91             }
92             }
93             sub to_json{
94 0     0 0   my $self = shift;
95 0           my $r = eval{
96 0           Mojo::JSON::to_json(@_);
97             };
98 0 0         if($@){
99 0           $self->warn($@);
100 0           $self->warn(__PACKAGE__ . "::to_json return undef value");
101 0           return undef;
102             }
103             else{
104 0 0         $self->warn(__PACKAGE__ . "::to_json return undef value") if not defined $r;
105 0           return $r;
106             }
107             }
108             sub decode_json{
109 0     0 0   my $self = shift;
110 0           my $r = eval{
111 0           Mojo::JSON::decode_json(@_);
112             };
113 0 0         if($@){
114 0           $self->warn($@);
115 0           $self->warn(__PACKAGE__ . "::decode_json return undef value");
116 0           return undef;
117             }
118             else{
119 0 0         $self->warn(__PACKAGE__ . "::decode_json return undef value") if not defined $r;
120 0           return $r;
121             }
122             }
123             sub encode_json{
124 0     0 0   my $self = shift;
125 0           my $r = eval{
126 0           Mojo::JSON::encode_json(@_);
127             };
128 0 0         if($@){
129 0           $self->warn($@);
130 0 0         $self->warn(__PACKAGE__ . "encode_json return undef value") if not defined $r;
131 0           return undef;
132             }
133             else{
134 0 0         $self->warn(__PACKAGE__ . "encode_json return undef value") if not defined $r;
135 0           return $r;
136             }
137             }
138              
139             sub truncate {
140 0     0 0   my $self = shift;
141 0   0       my $out_and_err = shift || '';
142 0           my %p = @_;
143 0   0       my $max_bytes = $p{max_bytes} || 200;
144 0   0       my $max_lines = $p{max_lines} || 10;
145 0           my $is_truncated = 0;
146 0 0         if(length($out_and_err)>$max_bytes){
147 0           $out_and_err = substr($out_and_err,0,$max_bytes);
148 0           $is_truncated = 1;
149             }
150 0           my @l =split /\n/,$out_and_err,$max_lines+1;
151 0 0         if(@l>$max_lines){
152 0           $out_and_err = join "\n",@l[0..$max_lines-1];
153 0           $is_truncated = 1;
154             }
155 0 0         return $out_and_err. ($is_truncated?"\n(已截断)":"");
156             }
157             sub reform{
158 0     0 0   my $self = shift;
159 0           my $ref = shift;
160 0           my %opt = @_;
161 0   0       my $unicode = $opt{unicode} // 0;
162 0   0       my $recursive = $opt{recursive} // 1;
163 0           my $cb = $opt{filter};
164 0   0       my $deep = $opt{deep} // 0;
165 0 0         if(ref $ref eq 'HASH'){
    0          
166 0           my @reform_hash_keys;
167 0           for (keys %$ref){
168 0 0 0       next if ref $cb eq "CODE" and !$cb->("HASH",$deep,$_,$ref->{$_});
169 0 0         if($_ !~ /^[[:ascii:]]+$/){
170 0 0 0       if($unicode and not Encode::is_utf8($_)){
    0 0        
171 0           push @reform_hash_keys,[ $_,Encode::decode_utf8($_) ];
172             }
173             elsif(!$unicode and Encode::is_utf8($_)){
174 0           push @reform_hash_keys,[ $_,Encode::encode_utf8($_) ];
175             }
176             }
177            
178 0 0 0       if(ref $ref->{$_} eq ""){
    0 0        
179 0 0 0       if($unicode and not Encode::is_utf8($ref->{$_}) ){
    0 0        
180 0           Encode::_utf8_on($ref->{$_});
181             }
182             elsif( !$unicode and Encode::is_utf8($ref->{$_}) ){
183 0           Encode::_utf8_off($ref->{$_});
184             }
185             }
186             elsif( $recursive and ref $ref->{$_} eq "ARRAY" or ref $ref->{$_} eq "HASH"){
187 0           $self->reform($ref->{$_},@_,deep=>$deep+1);
188             }
189             #else{
190             # $self->die("不支持的hash结构\n");
191             #}
192             }
193              
194 0           for(@reform_hash_keys){ $ref->{$_->[1]} = delete $ref->{$_->[0]} }
  0            
195             }
196             elsif(ref $ref eq 'ARRAY'){
197 0           for(@$ref){
198 0 0 0       next if ref $cb eq "CODE" and !$cb->("ARRAY",$deep,$_);
199 0 0 0       if(ref $_ eq ""){
    0 0        
200 0 0 0       if($unicode and not Encode::is_utf8($_) ){
    0 0        
201 0           Encode::_utf8_on($_);
202             }
203             elsif( !$unicode and Encode::is_utf8($_) ){
204 0           Encode::_utf8_off($_);
205             }
206             }
207             elsif($recursive and ref $_ eq "ARRAY" or ref $_ eq "HASH"){
208 0           $self->reform($_,@_,deep=>$deep+1);
209             }
210             #else{
211             # $self->die("不支持的hash结构\n");
212             #}
213             }
214             }
215             else{
216 0           $self->die("不支持的数据结构");
217             }
218 0           $self;
219             }
220             sub array_diff{
221 0     0 0   my $self = shift;
222 0           my $old = shift;
223 0           my $new = shift;
224 0           my $compare = shift;
225 0           my $old_hash = {};
226 0           my $new_hash = {};
227 0           my $added = [];
228 0           my $deleted = [];
229 0           my $same = {};
230              
231 0           my %e = map {$compare->($_) => undef} @{$new};
  0            
  0            
232 0           for(@{$old}){
  0            
233 0 0         unless(exists $e{$compare->($_)}){
234 0           push @{$deleted},$_;
  0            
235             }
236             else{
237 0           $same->{$compare->($_)}[0] = $_;
238             }
239             }
240              
241 0           %e = map {$compare->($_) => undef} @{$old};
  0            
  0            
242 0           for(@{$new}){
  0            
243 0 0         unless(exists $e{$compare->($_)}){
244 0           push @{$added},$_;
  0            
245             }
246             else{
247 0           $same->{$compare->($_)}[1] = $_;
248             }
249             }
250 0           return $added,$deleted,[values %$same];
251             }
252              
253             sub array_unique {
254 0     0 0   my $self = shift;
255 0           my $diff = pop;
256 0           my $array = shift;
257 0           my @result;
258             my %info;
259 0           my %tmp;
260 0           for(@$array){
261 0           my $id = $diff->($_);
262 0           $tmp{$id}++;
263             }
264 0           for(@$array){
265 0           my $id = $diff->($_);
266 0 0         next if not exists $tmp{$id} ;
267 0 0         next if $tmp{$id}>1;
268 0           push @result,$_;
269 0 0         $info{$id} = $_ if wantarray;
270             }
271 0 0         return wantarray?(\@result,\%info):\@result;
272             }
273             sub die{
274 0     0 0   my $self = shift;
275 0     0     local $SIG{__DIE__} = sub{$self->log->fatal(@_);exit -1};
  0            
  0            
276 0           Carp::confess(@_);
277             }
278             sub info{
279 0     0 0   my $self = shift;
280 0           $self->log->info(@_);
281 0           $self;
282             }
283             sub warn{
284 0     0 0   my $self = shift;
285             ref $_[0] eq 'HASH' ?
286 0 0 0       ($_[0]->{level_color} //= 'yellow' and $_[0]->{content_color} //= 'yellow')
287             : unshift @_,{level_color=>'yellow',content_color=>'yellow'};
288 0           $self->log->warn(@_);
289 0           $self;
290             }
291             sub msg{
292 0     0 0   my $self = shift;
293 0           $self->log->msg(@_);
294 0           $self;
295             }
296             sub error{
297 0     0 0   my $self = shift;
298             ref $_[0] eq 'HASH' ?
299 0 0 0       ($_[0]->{level_color} //= 'red' and $_[0]->{content_color} //= 'red')
300             : unshift @_,{level_color=>'red',content_color=>'red'};
301 0           $self->log->error(@_);
302 0           $self;
303             }
304             sub fatal{
305 0     0 0   my $self = shift;
306             ref $_[0] eq 'HASH' ?
307 0 0 0       ($_[0]->{level_color} //= 'red' and $_[0]->{content_color} //= 'red')
308             : unshift @_,{level_color=>'red',content_color=>'red'};
309 0           $self->log->fatal(@_);
310 0           $self;
311             }
312             sub debug{
313 0     0 0   my $self = shift;
314             ref $_[0] eq 'HASH' ?
315 0 0 0       ($_[0]->{level_color} //= 'blue' and $_[0]->{content_color} //= 'blue')
316             : unshift @_,{level_color=>'blue',content_color=>'blue'};
317 0           $self->log->debug(@_);
318 0           $self;
319             }
320             sub print {
321 0     0 0   my $self = shift;
322             #my $flag = 1;
323             #if($flag){
324 0 0         $self->log->info({time=>'',level=>'',},join (defined $,?$,:''),@_);
325             #}
326             #else{
327             # $self->log->info(join (defined $,?$,:''),@_);
328             #}
329 0           $self;
330             }
331              
332             sub stdout_line {
333 0     0 0   my $self = shift;
334 0           my $data = $_[0];
335 0           $data=~s/[\r\n]+$//s;
336 0           STDOUT->printflush($data . "\n");
337 0           $self;
338             }
339              
340             1;