File Coverage

blib/lib/DataStore/CAS/FS/InvalidUTF8.pm
Criterion Covered Total %
statement 40 41 97.5
branch 12 14 85.7
condition 3 6 50.0
subroutine 12 13 92.3
pod 8 9 88.8
total 75 83 90.3


line stmt bran cond sub pod time code
1             package DataStore::CAS::FS::InvalidUTF8;
2 8     8   488 use strict;
  8         10  
  8         178  
3 8     8   23 use warnings;
  8         9  
  8         137  
4 8     8   26 use Carp;
  8         13  
  8         531  
5 8     8   27 use overload '""' => \&to_string, 'cmp' => \&str_compare, '.' => \&str_concat;
  8         8  
  8         55  
6              
7             our $VERSION= '0.011000';
8              
9             # ABSTRACT: Wrapper to represent non-utf8 data in a unicode context
10              
11              
12             sub decode_utf8 {
13 66     66 1 2778 my $str= $_[-1];
14 66 50 33     152 !ref $str || ref($str)->isa(__PACKAGE__)
15             or croak "Can't convert ".ref($str);
16 66 100 66     611 return ref($str) || utf8::is_utf8($str) || utf8::decode($str)? $str
17             : bless(\$str, __PACKAGE__);
18             }
19              
20 0     0 1 0 sub is_non_unicode { 1 }
21              
22 13     13 1 2109 sub to_string { ${$_[0]} }
  13         228  
23              
24             sub str_compare {
25 2     2 1 104 my ($self, $other, $swap)= @_;
26 2 100       6 if (ref $other eq __PACKAGE__) { $other= $$other } else { utf8::encode($other) }
  1         2  
  1         2  
27 2         3 my $ret= $$self cmp $other;
28 2 100       15 return $swap? -$ret : $ret;
29             }
30              
31             sub str_concat {
32 2     2 1 4 my ($self, $other, $swap)= @_;
33 2 100       4 if (ref $other eq __PACKAGE__) { $other= $$other } else { utf8::encode($other) }
  1         2  
  1         2  
34 2 100       9 return ref($self)->decode_utf8($swap? $other.$$self : $$self.$other);
35             }
36              
37              
38             sub add_json_filter {
39 5     5 1 8 my ($self, $json)= @_;
40 5         33 $json->filter_json_single_key_object(
41             '*InvalidUTF8*' => \&FROM_JSON
42             );
43 5         45 $json;
44             }
45              
46             sub TO_JSON {
47 3     3 1 17 my $x= ${$_[0]};
  3         22  
48 3         6 utf8::upgrade($x);
49 3         17 return { '*InvalidUTF8*' => $x };
50             }
51              
52             sub FROM_JSON {
53 3     3 1 10 my $x= $_[0];
54 3 50       11 utf8::downgrade($x) if utf8::is_utf8($x);
55 3         15 return bless \$x, __PACKAGE__;
56             }
57              
58             sub TO_UTF8 {
59 4     4 0 5 ${$_[0]};
  4         60  
60             }
61              
62             1;
63              
64             __END__