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