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