Commit | Line | Data |
64ffdd5e |
1 | package Encode::KR::2022_KR; |
0ab8f81e |
2 | use Encode qw(:fallbacks); |
64ffdd5e |
3 | use base 'Encode::Encoding'; |
4 | |
5 | use strict; |
6 | |
011b2d2f |
7 | our $VERSION = do { my @r = (q$Revision: 1.4 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; |
64ffdd5e |
8 | |
64ffdd5e |
9 | |
10 | my $canon = 'iso-2022-kr'; |
11 | my $obj = bless {name => $canon}, __PACKAGE__; |
12 | $obj->Define($canon); |
13 | |
14 | sub name { return $_[0]->{name}; } |
15 | |
6d1c0808 |
16 | sub needs_lines { 1 } |
17 | |
0ab8f81e |
18 | sub perlio_ok { |
0ab8f81e |
19 | return 0; # for the time being |
20 | } |
21 | |
64ffdd5e |
22 | sub decode |
23 | { |
0ab8f81e |
24 | my ($obj, $str, $chk) = @_; |
64ffdd5e |
25 | my $res = $str; |
0ab8f81e |
26 | my $residue = iso_euc(\$res); |
27 | # This is for PerlIO |
28 | $_[1] = $residue if $chk; |
29 | return Encode::decode('euc-kr', $res, FB_PERLQQ); |
64ffdd5e |
30 | } |
31 | |
32 | sub encode |
33 | { |
0ab8f81e |
34 | my ($obj, $utf8, $chk) = @_; |
35 | # empty the input string in the stack so perlio is ok |
36 | $_[1] = '' if $chk; |
37 | my $octet = Encode::encode('euc-jp', $utf8, FB_PERLQQ) ; |
38 | euc_iso(\$octet); |
39 | return $octet; |
64ffdd5e |
40 | } |
41 | |
42 | use Encode::CJKConstants qw(:all); |
43 | |
44 | # ISO<->EUC |
45 | |
67d7b5ef |
46 | sub iso_euc{ |
64ffdd5e |
47 | my $r_str = shift; |
6d1c0808 |
48 | $$r_str =~ s/$RE{'2022_KR'}//gox; # remove the designator |
0ab8f81e |
49 | $$r_str =~ s{ # replace characters in GL |
50 | \x0e # between SO(\x0e) and SI(\x0f) |
51 | ([^\x0f]*) # with characters in GR |
67d7b5ef |
52 | \x0f |
0ab8f81e |
53 | } |
67d7b5ef |
54 | { |
0ab8f81e |
55 | my $out= $1; |
67d7b5ef |
56 | $out =~ tr/\x21-\x7e/\xa1-\xfe/; |
57 | $out; |
64ffdd5e |
58 | }geox; |
0ab8f81e |
59 | my ($residue) = ($$r_str =~ s/(\e.*)$//so); |
60 | return $residue; |
64ffdd5e |
61 | } |
62 | |
63 | sub euc_iso{ |
0ab8f81e |
64 | no warnings qw(uninitialized); |
64ffdd5e |
65 | my $r_str = shift; |
6d1c0808 |
66 | substr($$r_str,0,0)=$ESC{'2022_KR'}; # put the designator at the beg. |
0ab8f81e |
67 | $$r_str =~ s{ # move KS X 1001 characters in GR to GL |
68 | ($RE{EUC_C}+) # and enclose them with SO and SI |
69 | }{ |
70 | my $str = $1; |
71 | $str =~ tr/\xA1-\xFE/\x21-\x7E/; |
72 | "\x0e" . $str . "\x0f"; |
73 | }geox; |
64ffdd5e |
74 | $$r_str; |
75 | } |
76 | |
77 | 1; |
78 | __END__ |
b2704119 |
79 | |
80 | =head1 NAME |
81 | |
82 | Encode::KR::2022_KR -- internally used by Encode::KR |
83 | |
84 | =cut |