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