[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/i586-linux-thread-multi/Encode/KR/ -> 2022_KR.pm (source)

   1  package Encode::KR::2022_KR;
   2  use strict;
   3  use warnings;
   4  our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\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      my ( $obj, $str, $chk ) = @_;
  19      my $res     = $str;
  20      my $residue = iso_euc( \$res );
  21  
  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      my ( $obj, $utf8, $chk ) = @_;
  29  
  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 ) =
  62        $ESC{'2022_KR'};    # put the designator at the beg.
  63      $$r_str =~
  64        s{                         # move KS X 1001 characters in GR to GL
  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;
  71      $$r_str;
  72  }
  73  
  74  1;
  75  __END__
  76  
  77  =head1 NAME
  78  
  79  Encode::KR::2022_KR -- internally used by Encode::KR
  80  
  81  =cut


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1