File Coverage

blib/lib/String/Multibyte/UTF8.pm
Criterion Covered Total %
statement 6 6 100.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 8 8 100.0


line stmt bran cond sub pod time code
1             package String::Multibyte::UTF8;
2              
3 13     13   95 use vars qw($VERSION);
  13     1   22  
  13         5749  
  1         9  
  1         2  
  1         433  
4             $VERSION = '1.12';
5              
6             +{
7             charset => 'UTF-8',
8              
9             regexp => '(?:[\x00-\x7F]|[\xC2-\xDF][\x80-\xBF]|' .
10             '\xE0[\xA0-\xBF][\x80-\xBF]|\xED[\x80-\x9F][\x80-\xBF]|' .
11             '[\xE1-\xEC\xEE\xEF][\x80-\xBF][\x80-\xBF]|' .
12             '\xF0[\x90-\xBF][\x80-\xBF][\x80-\xBF]|' .
13             '[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]|' .
14             '\xF4[\x80-\x8F][\x80-\xBF][\x80-\xBF])',
15              
16             cmpchar => sub { $_[0] cmp $_[1] },
17              
18             nextchar => sub {
19             my $ch = shift;
20             my $len = length $ch;
21             if ($len < 1 || 4 < $len) {
22             return undef;
23             }
24             elsif ($len == 1) {
25             return $ch eq "\x7F"
26             ? "\xC2\x80"
27             : chr(ord($ch)+1);
28             }
29             elsif ($len == 2) {
30             my($c,$d) = unpack('CC',$ch);
31             return $ch eq "\xDF\xBF"
32             ? "\xE0\xA0\x80"
33             : $d == 0xBF
34             ? chr($c+1)."\x80"
35             : pack('CC', $c, $d+1);
36             }
37             elsif ($len == 3) {
38             my($c,$d,$e) = unpack('CCC',$ch);
39             return $ch eq "\xEF\xBF\xBF"
40             ? "\xF0\x90\x80\x80"
41             : $ch eq "\xED\x9F\xBF"
42             ? "\xEE\x80\x80"
43             : $e == 0xBF
44             ? $d == 0xBF
45             ? chr($c+1)."\x80\x80"
46             : pack('CCC', $c, $d+1, 0x80)
47             : pack('CCC', $c, $d, $e+1);
48             }
49             else {
50             my($c,$d,$e,$f) = unpack('CCCC',$ch);
51             return $ch ge "\xF4\x8F\xBF\xBF"
52             ? undef
53             : $f == 0xBF
54             ? $e == 0xBF
55             ? $d == 0xBF
56             ? chr($c+1)."\x80\x80\x80"
57             : pack('CCCC', $c, $d+1, 0x80, 0x80)
58             : pack('CCCC', $c, $d, $e+1, 0x80)
59             : pack('CCCC', $c, $d, $e, $f+1);
60             }
61             },
62             };
63              
64             __END__