File Coverage

blib/lib/Weixin/Util.pm
Criterion Covered Total %
statement 16 49 32.6
branch 0 8 0.0
condition 0 9 0.0
subroutine 5 11 45.4
pod 0 6 0.0
total 21 83 25.3


line stmt bran cond sub pod time code
1             package Weixin::Util;
2 1     1   13 use Exporter 'import';
  1         1  
  1         40  
3 1     1   639 use Encode ();
  1         12575  
  1         26  
4 1     1   1657 use Encode::Locale;
  1         3508  
  1         84  
5             our @EXPORT = qw(gen_url gen_url2 code2sex console truncate uri_escape encode decode encode_utf8) ;
6             our @EXPORT_OK = qw(gen_url gen_url2 code2sex console truncate uri_escape encode decode encode_utf8) ;
7 1     1   502 use URI::Escape ();
  1         1143  
  1         46  
8             BEGIN{
9 1     1   4 *uri_escape= *URI::Escape::uri_escape;
10 1         2 *encode = *Encode::encode;
11 1         1 *decode = *Encode::decode;
12 1         405 *encode_utf8 = *Encode::encode_utf8;
13             }
14             sub gen_url{
15 0     0 0   my ($url,@query_string) = @_;
16 0           my @query_string_pairs;
17 0           push @query_string_pairs , shift(@query_string) . "=" . shift(@query_string) while(@query_string);
18 0           return $url . '?' . join("&",@query_string_pairs);
19             }
20             sub gen_url2 {
21 0     0 0   my ($url,@query_string) = @_;
22 0           my @query_string_pairs;
23 0           push @query_string_pairs , shift(@query_string) . "=" . uri_escape(shift(@query_string)) while(@query_string);
24 0           return $url . '?' . join("&",@query_string_pairs);
25             }
26              
27             sub console{
28 0     0 0   my $bytes = join "",@_;
29 0           print encode("locale",decode("utf8",$bytes));
30             }
31              
32             sub truncate {
33 0     0 0   my $out_and_err = shift;
34 0           my %p = @_;
35 0   0       my $max_bytes = $p{max_bytes} || 200;
36 0   0       my $max_lines = $p{max_lines} || 10;
37 0           my $is_truncated = 0;
38 0 0         if(length($out_and_err)>$max_bytes){
39 0           $out_and_err = substr($out_and_err,0,$max_bytes);
40 0           $is_truncated = 1;
41             }
42 0           my @l =split /\n/,$out_and_err,$max_lines+1;
43 0 0         if(@l>$max_lines){
44 0           $out_and_err = join "\n",@l[0..$max_lines-1];
45 0           $is_truncated = 1;
46             }
47 0 0         return $out_and_err. ($is_truncated?"\n(已截断)":"");
48             }
49             sub each {
50 0     0 0   my $callback = pop;
51 0           my @data;
52 0 0 0       if(@_ == 1 and reftype $_[0] eq 'ARRAY'){
53 0           @data = @$_[0];
54             }
55             else{
56 0           @data = @_;
57             }
58 0           for (@data){
59 0           $callback->($_);
60             }
61             }
62              
63             sub code2sex{
64 0     0 0   my $c = shift;
65 0           my %h = qw(
66             0 none
67             1 male
68             2 female
69             );
70 0   0       return $h{$c} || "none";
71             }
72             1;