ext/Encode/lib/Encode/KR/2022_KR.pm

   1 package Encode::KR::2022_KR;
   2 use Encode::KR;
   3 use base 'Encode::Encoding';
   4
   5 use strict;
   6
   7 our $VERSION = do { my @r = (q$Revision: 1.0 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
   8
   9
  10 my $canon = 'iso-2022-kr';
  11 my $obj = bless {name => $canon}, __PACKAGE__;
  12 $obj->Define($canon);
  13
  14 sub name { return $_[0]->{name}; }
  15
  16 sub decode
  17 {
  18     my ($obj,$str,$chk) = @_;
  19     my $res = $str;
  20     iso_euc(\$res);
  21     return Encode::decode('euc-kr', $res, $chk);
  22 }
  23
  24 sub encode
  25 {
  26     my ($obj,$str,$chk) = @_;
  27     my $res = Encode::encode('euc-kr', $str, $chk);
  28     euc_iso(\$res);
  29     return $res;
  30 }
  31
  32 use Encode::CJKConstants qw(:all);
  33
  34 # ISO<->EUC
  35
  36 sub iso_euc{
  37     my $r_str = shift;
  38     $$r_str =~ s/$RE{'2022_KR'}//gox;  # remove the designator
  39     $$r_str =~ s{                    # replace chars. in GL
  40      \x0e                            # between SO(\x0e) and SI(\x0f)
  41      ([^\x0f]*)                      # with chars. in GR
  42      \x0f
  43         }
  44     {
  45                         my $out= $1;
  46       $out =~ tr/\x21-\x7e/\xa1-\xfe/;
  47       $out;
  48     }geox;
  49     $$r_str;
  50 }
  51
  52 sub euc_iso{
  53     my $r_str = shift;
  54     substr($$r_str,0,0)=$ESC{'2022_KR'};  # put the designator at the beg.
  55     $$r_str =~ s{                     # move KS X 1001 chars. in GR to GL
  56         ($RE{EUC_C}+)                       # and enclose them with SO and SI
  57         }{
  58             my $str = $1;
  59             $str =~ tr/\xA1-\xFE/\x21-\x7E/;
  60             "\x0e" . $str . "\x0f";
  61         }geox;
  62     $$r_str;
  63 }
  64
  65 1;
  66 __END__