File Coverage

blib/arch/Panda/Lib.pm
Criterion Covered Total %
statement 53 55 96.3
branch 25 32 78.1
condition 1 2 50.0
subroutine 10 10 100.0
pod 0 3 0.0
total 89 102 87.2


line stmt bran cond sub pod time code
1             package Panda::Lib;
2 10     10   103739 use parent 'Panda::Export';
  10         3324  
  10         56  
3 10     10   87281 use 5.012;
  10         44  
4 10     10   5841 use Encode();
  10         128639  
  10         284  
5 10     10   5324 use Time::HiRes();
  10         12867  
  10         536  
6              
7             our $VERSION = '1.3.2';
8              
9             use Panda::Export
10 10         1700 MERGE_ARRAY_CONCAT => 1,
11             MERGE_ARRAY_MERGE => 2,
12             MERGE_COPY_DEST => 4,
13             MERGE_LAZY => 8,
14             MERGE_SKIP_UNDEF => 16,
15             MERGE_DELETE_UNDEF => 32,
16 10     10   78 MERGE_COPY_SOURCE => 64;
  10         27  
17             use Panda::Export
18 10     10   79 MERGE_COPY => MERGE_COPY_DEST | MERGE_COPY_SOURCE;
  10         25  
  10         4598  
19            
20             require Panda::XSLoader;
21             Panda::XSLoader::bootstrap();
22              
23             *hash_cmp = *compare; # for compability
24              
25             sub timeout {
26 2     2 0 1430 my ($sub, $timeout) = @_;
27 2 50       7 if (state $in_debugger = defined $DB::header) { $sub->(); return 1 }
  0         0  
  0         0  
28 2         4 my ($ok, $alarm, $error);
29 2     1   50 local $SIG{ALRM} = sub {$alarm = 1; die "ALARM!"};
  1         100131  
  1         39  
30 2   50     32 Time::HiRes::alarm($timeout || 1);
31 2         5 eval {
32 2 100       4 eval { $sub->(); 1 } or do { $error = $@ };
  2         8  
  1         8  
  1         5  
33 2         18 Time::HiRes::alarm(0);
34             };
35 2 100       30 return if $alarm;
36 1 50       4 die $error if $error;
37 1         9 return 1;
38             }
39              
40             sub encode_utf8_struct {
41 3     3 0 16759 my $data = shift;
42 3 100       19 if (ref($data) eq 'HASH') {
    50          
43 2         10 foreach my $v (values %$data) {
44 3 100       30 if (ref $v) { encode_utf8_struct($v) }
  1 50       7  
45 2         12 elsif (utf8::is_utf8($v)) { $v = Encode::encode_utf8($v) }
46             }
47             }
48             elsif (ref($data) eq 'ARRAY') {
49             map {
50 1 100       5 if (ref $_) { encode_utf8_struct($_) }
  4 100       41  
  1         6  
51 1         6 elsif (utf8::is_utf8($_)) { $_ = Encode::encode_utf8($_) }
52             } @$data;
53             }
54             }
55              
56              
57             sub decode_utf8_struct {
58 3     3 0 1029 my $data = shift;
59 3 100       15 if (ref($data) eq 'HASH') {
    50          
60 2         8 foreach my $v (values %$data) {
61 3 100       35 if (ref $v) { decode_utf8_struct($v) }
  1 50       5  
62 2         7 elsif (!utf8::is_utf8($v)) { $v = Encode::decode_utf8($v) }
63             }
64             }
65             elsif (ref($data) eq 'ARRAY') {
66             map {
67 1 100       3 if (ref $_) { decode_utf8_struct($_) }
  4 50       99  
  1         7  
68 3         9 elsif (!utf8::is_utf8($_)) { $_ = Encode::decode_utf8($_) }
69             } @$data;
70             }
71             }
72              
73             1;