From 779e71f16ca01a6244b632b95bdb461fec163b34 Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Thu, 17 Feb 2011 17:56:54 +0000 Subject: New tlperl part XIII git-svn-id: svn://tug.org/texlive/trunk@21435 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/tlperl/lib/Encode/KR/2022_KR.pm | 81 ++++++++++++++++++++++++++++ 1 file changed, 81 insertions(+) create mode 100644 Master/tlpkg/tlperl/lib/Encode/KR/2022_KR.pm (limited to 'Master/tlpkg/tlperl/lib/Encode/KR') diff --git a/Master/tlpkg/tlperl/lib/Encode/KR/2022_KR.pm b/Master/tlpkg/tlperl/lib/Encode/KR/2022_KR.pm new file mode 100644 index 00000000000..0218d971ee2 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Encode/KR/2022_KR.pm @@ -0,0 +1,81 @@ +package Encode::KR::2022_KR; +use strict; +use warnings; +our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; + +use Encode qw(:fallbacks); + +use base qw(Encode::Encoding); +__PACKAGE__->Define('iso-2022-kr'); + +sub needs_lines { 1 } + +sub perlio_ok { + return 0; # for the time being +} + +sub decode { + my ( $obj, $str, $chk ) = @_; + my $res = $str; + my $residue = iso_euc( \$res ); + + # This is for PerlIO + $_[1] = $residue if $chk; + return Encode::decode( 'euc-kr', $res, FB_PERLQQ ); +} + +sub encode { + my ( $obj, $utf8, $chk ) = @_; + + # empty the input string in the stack so perlio is ok + $_[1] = '' if $chk; + my $octet = Encode::encode( 'euc-kr', $utf8, FB_PERLQQ ); + euc_iso( \$octet ); + return $octet; +} + +use Encode::CJKConstants qw(:all); + +# ISO<->EUC + +sub iso_euc { + my $r_str = shift; + $$r_str =~ s/$RE{'2022_KR'}//gox; # remove the designator + $$r_str =~ s{ # replace characters in GL + \x0e # between SO(\x0e) and SI(\x0f) + ([^\x0f]*) # with characters in GR + \x0f + } + { + my $out= $1; + $out =~ tr/\x21-\x7e/\xa1-\xfe/; + $out; + }geox; + my ($residue) = ( $$r_str =~ s/(\e.*)$//so ); + return $residue; +} + +sub euc_iso { + no warnings qw(uninitialized); + my $r_str = shift; + substr( $$r_str, 0, 0 ) = + $ESC{'2022_KR'}; # put the designator at the beg. + $$r_str =~ + s{ # move KS X 1001 characters in GR to GL + ($RE{EUC_C}+) # and enclose them with SO and SI + }{ + my $str = $1; + $str =~ tr/\xA1-\xFE/\x21-\x7E/; + "\x0e" . $str . "\x0f"; + }geox; + $$r_str; +} + +1; +__END__ + +=head1 NAME + +Encode::KR::2022_KR -- internally used by Encode::KR + +=cut -- cgit v1.2.3