File Coverage

blib/lib/String/Multibyte/Johab.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package String::Multibyte::Johab;
2              
3 1     1   6 use vars qw($VERSION);
  1         1  
  1         53  
4             $VERSION = '1.02';
5              
6             # Hangul Letter Next Trailing Byte
7 1     1   4 use vars qw(@HLNT %HLNT1 %HLNT2 %HLNT3);
  1         3  
  1         65  
8              
9             # Hangul Syllable Next Trailing Byte
10 1     1   5 use vars qw(@HSNT %HSNT1 %HSNT2 %HSNT3);
  1         2  
  1         592  
11              
12             %HLNT1 = (
13             0x44, 0x46, 0x47, 0x4A, 0x50, 0x54,
14             0x54, 0x61, 0x61, 0x81, 0x81, 0xA1,
15             0xA1, 0xC1, 0xC1, 0xE1, 0xE1, 0x41,
16             );
17              
18             %HLNT2 = (
19             0x41, 0x61, 0x61, 0x81, 0x81, 0xA1,
20             0xA1, 0xC1, 0xC1, 0xE1, 0xE1, 0x41,
21             );
22              
23             %HLNT3 = (
24             0x41, 0x61, 0x61, 0x81, 0x81, 0xA1,
25             0xA1, 0x41,
26             );
27              
28             @HLNT = (\%HLNT1, \%HLNT2, \%HLNT2, \%HLNT3);
29              
30             %HSNT1 = (
31             0x41, 0x61, 0x71, 0x73, 0x7D, 0x81,
32             0x91, 0x93, 0x9D, 0xA1, 0xB1, 0xB3,
33             0xBD, 0xC1, 0xD1, 0xD3, 0xDD, 0xE1,
34             0xF1, 0xF3, 0xFD, 0x41,
35             );
36              
37             %HSNT2 = (
38             0x51, 0x53, 0x5D, 0x61, 0x71, 0x73,
39             0x7D, 0x81, 0x91, 0x93, 0x9D, 0xA1,
40             0xB1, 0xB3, 0xBD, 0xC1, 0xD1, 0xD3,
41             0xDD, 0xE1, 0xF1, 0xF3, 0xFD, 0x41,
42             );
43              
44             %HSNT3 = (
45             0x51, 0x53, 0x5D, 0x61, 0x71, 0x73,
46             0x7D, 0x81, 0x91, 0x93, 0x9D, 0xA1,
47             0xB1, 0xB3, 0xBD, 0x41,
48             );
49              
50             @HSNT = (\%HSNT1, \%HSNT2, \%HSNT2, \%HSNT3);
51              
52              
53             +{
54             charset => 'Johab',
55              
56             regexp => '(?:[\x00-\x7F]|[\xD8-\xDE\xE0-\xF9][\x31-\x7E\x91-\xFE]|'
57             . '\x84[\x44\x46\x47\x4A-\x50\x54\x61\x81\xA1\xC1\xE1]|'
58             . '[\x85\x86][\x41\x61\x81\xA1\xC1\xE1]|\x87[\x41\x61\x81\xA1]|'
59             . '[\x88\x8C\x90\x94\x98\x9C\xA0\xA4\xA8\xAC\xB0\xB4\xB8\xBC'
60             . '\xC0\xC4\xC8\xCC\xD0][\x41\x61-\x71\x73-\x7D\x81-\x91\x93-\x9D'
61             . '\xA1-\xB1\xB3-\xBD\xC1-\xD1\xD3-\xDD\xE1-\xF1\xF3-\xFD]|'
62             . '[\x89\x8A\x8D\x8E\x91\x92\x95\x96\x99\x9A\x9D\x9E\xA1\xA2\xA5\xA6'
63             . '\xA9\xAA\xAD\xAE\xB1\xB2\xB5\xB6\xB9\xBA\xBD\xBE\xC1\xC2\xC5\xC6'
64             . '\xC9\xCA\xCD\xCE\xD1\xD2][\x41-\x51\x53-\x5D\x61-\x71\x73-\x7D'
65             . '\x81-\x91\x93-\x9D\xA1-\xB1\xB3-\xBD\xC1-\xD1\xD3-\xDD\xE1-\xF1'
66             . '\xF3-\xFD]|'
67             . '[\x8B\x8F\x93\x97\x9B\x9F\xA3\xA7\xAB\xAF\xB3\xB7\xBB\xBF\xC3\xC7'
68             . '\xCB\xCF\xD3][\x41-\x51\x53-\x5D\x61-\x71\x73-\x7D\x81-\x91'
69             . '\x93-\x9D\xA1-\xB1\xB3-\xBD])',
70              
71             cmpchar => sub { $_[0] cmp $_[1] },
72              
73             nextchar => sub {
74             my $ch = shift;
75             my $len = length $ch;
76             if ($len == 1) {
77             return $ch eq "\x7F"
78             ? "\x84\x44"
79             : chr(ord($ch)+1);
80             }
81             elsif ($len == 2) {
82             return undef if $ch eq "\xF9\xFE";
83             return "\xD8\x31" if $ch eq "\xD3\xBD"; # Hangul to non-Hangul
84             return "\xE0\x31" if $ch eq "\xDE\xFE"; # gap in non-Hangul
85              
86             my ($n, $c, $d);
87             ($c, $d) = unpack('CC', $ch);
88              
89             if (0x84 <= $c && $c <= 0x87 && ($n = $HLNT[$c % 4]{$d}) ||
90             0x88 <= $c && $c <= 0xD3 && ($n = $HSNT[$c % 4]{$d}) ) {
91             return $n == 0x41
92             ? pack('CC', $c+1, $n)
93             : pack('CC', $c, $n);
94             }
95             else {
96             return $d == 0xFE
97             ? chr($c+1)."\x31"
98             : $d == 0x7E
99             ? chr($c)."\x91"
100             : pack('CC', $c, $d+1);
101             }
102             }
103             else {
104             return;
105             }
106             },
107             };
108              
109             __END__