Commit | Line | Data |
64ffdd5e |
1 | package Encode::KR::2022_KR; |
64ffdd5e |
2 | use strict; |
656ebd29 |
3 | use warnings; |
4 | our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\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 | |
d1256cb1 |
11 | sub needs_lines { 1 } |
6d1c0808 |
12 | |
d1256cb1 |
13 | sub perlio_ok { |
14 | return 0; # for the time being |
0ab8f81e |
15 | } |
16 | |
d1256cb1 |
17 | sub decode { |
18 | my ( $obj, $str, $chk ) = @_; |
19 | my $res = $str; |
20 | my $residue = iso_euc( \$res ); |
21 | |
0ab8f81e |
22 | # This is for PerlIO |
23 | $_[1] = $residue if $chk; |
d1256cb1 |
24 | return Encode::decode( 'euc-kr', $res, FB_PERLQQ ); |
64ffdd5e |
25 | } |
26 | |
d1256cb1 |
27 | sub encode { |
28 | my ( $obj, $utf8, $chk ) = @_; |
29 | |
0ab8f81e |
30 | # empty the input string in the stack so perlio is ok |
31 | $_[1] = '' if $chk; |
d1256cb1 |
32 | my $octet = Encode::encode( 'euc-kr', $utf8, FB_PERLQQ ); |
33 | euc_iso( \$octet ); |
0ab8f81e |
34 | return $octet; |
64ffdd5e |
35 | } |
36 | |
37 | use Encode::CJKConstants qw(:all); |
38 | |
39 | # ISO<->EUC |
40 | |
d1256cb1 |
41 | sub iso_euc { |
64ffdd5e |
42 | my $r_str = shift; |
d1256cb1 |
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; |
d1256cb1 |
54 | my ($residue) = ( $$r_str =~ s/(\e.*)$//so ); |
0ab8f81e |
55 | return $residue; |
64ffdd5e |
56 | } |
57 | |
d1256cb1 |
58 | sub euc_iso { |
0ab8f81e |
59 | no warnings qw(uninitialized); |
64ffdd5e |
60 | my $r_str = shift; |
d1256cb1 |
61 | substr( $$r_str, 0, 0 ) = |
62 | $ESC{'2022_KR'}; # put the designator at the beg. |
63 | $$r_str =~ |
64 | s{ # move KS X 1001 characters in GR to GL |
0ab8f81e |
65 | ($RE{EUC_C}+) # and enclose them with SO and SI |
66 | }{ |
67 | my $str = $1; |
68 | $str =~ tr/\xA1-\xFE/\x21-\x7E/; |
69 | "\x0e" . $str . "\x0f"; |
70 | }geox; |
64ffdd5e |
71 | $$r_str; |
72 | } |
73 | |
74 | 1; |
75 | __END__ |
b2704119 |
76 | |
77 | =head1 NAME |
78 | |
79 | Encode::KR::2022_KR -- internally used by Encode::KR |
80 | |
81 | =cut |