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