File Coverage

blib/lib/String/Multibyte/EUC_TW.pm
Criterion Covered Total %
statement 3 3 100.0
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 4 4 100.0


line stmt bran cond sub pod time code
1             package String::Multibyte::EUC_TW;
2              
3 1     1   8 use vars qw($VERSION);
  1         3  
  1         391  
4             $VERSION = '1.02';
5              
6             +{
7             charset => 'EUC-TW',
8              
9             regexp => '(?:[\x00-\x7F]|[\xA1-\xFE][\xA1-\xFE]|' .
10             '\x8E[\xA1-\xB0][\xA1-\xFE][\xA1-\xFE])',
11              
12             cmpchar => sub {
13             length($_[0]) <=> length($_[1]) || $_[0] cmp $_[1];
14             },
15              
16             nextchar => sub {
17             my $ch = shift;
18             my $len = length $ch;
19             if ($len == 1) {
20             return $ch eq "\x7F"
21             ? "\xA1\xA1"
22             : chr(ord($ch)+1);
23             }
24             elsif ($len == 2) {
25             my($c,$d) = unpack('CC', $ch);
26             return $ch eq "\xFE\xFE"
27             ? "\x8E\xA1\xA1\xA1"
28             : $d == 0xFE
29             ? chr($c+1)."\xA1"
30             : pack('CC', $c, $d+1);
31             }
32             elsif ($len == 4) {
33             return unless $ch =~ s/^\x8E//;
34             my($b,$c,$d) = unpack('CCC',$ch);
35             return $d == 0xFE
36             ? $c == 0xFE
37             ? $b == 0xB0
38             ? undef
39             : pack('CCCC', 0x8E, $b+1, 0xA1, 0xA1)
40             : pack('CCCC', 0x8E, $b, $c+1, 0xA1)
41             : pack('CCCC', 0x8E, $b, $c, $d+1);
42             }
43             else {
44             return;
45             }
46             },
47             };
48              
49             __END__