File Coverage

blib/lib/String/Multibyte/EUC_JP.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::EUC_JP;
2              
3 13     13   99 use vars qw($VERSION);
  13     1   24  
  13         5244  
  1         10  
  1         2  
  1         305  
4             $VERSION = '1.02';
5              
6             +{
7             charset => 'EUC-JP',
8              
9             regexp => '(?:[\x00-\x7F]|[\x8E\xA1-\xFE][\xA1-\xFE]|' .
10             '\x8F[\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 || 3 < $len) {
20             return;
21             }
22             elsif ($len == 1) {
23             return $ch eq "\x7F"
24             ? "\x8E\xA1"
25             : chr(ord($ch)+1);
26             }
27             elsif ($len == 2) {
28             my($c,$d) = unpack('CC', $ch);
29             return $ch eq "\x8E\xFE"
30             ? "\xA1\xA1"
31             : $ch eq "\xFE\xFE"
32             ? "\x8F\xA1\xA1"
33             : $d == 0xFE
34             ? chr($c+1)."\xA1"
35             : pack('CC', $c, $d+1);
36             }
37             else {
38             return if 0x8F != ord $ch;
39             my($b,$c,$d) = unpack('CCC',$ch);
40             return $ch eq "\x8F\xFE\xFE"
41             ? undef
42             : $d == 0xFE
43             ? pack('CCC', 0x8F, $c+1, 0xA1)
44             : pack('CCC', 0x8F, $c, $d+1);
45             }
46             },
47             };
48              
49             __END__