home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _1072be7b393619a04f37ac3b3b0c2f21 < prev    next >
Text File  |  2004-06-01  |  2KB  |  80 lines
  1. package Encode::KR::2022_KR;
  2. use strict;
  3.  
  4. our $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\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
  80.