ext/Encode/lib/Encode/JP/JIS.pm

   1 package Encode::JP::JIS;
   2 use Encode::JP;
   3 use base 'Encode::Encoding';
   4
   5 use strict;
   6
   7 our $VERSION = do { my @r = (q$Revision: 0.99 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
   8
   9 # Just for the time being, we implement jis-7bit
  10 # encoding via EUC
  11
  12 my $canon = '7bit-jis';
  13 my $obj = bless {name => $canon}, __PACKAGE__;
  14 $obj->Define($canon);
  15
  16 sub name { return $_[0]->{name}; }
  17
  18 sub decode
  19 {
  20     my ($obj,$str,$chk) = @_;
  21     my $res = $str;
  22     jis_euc(\$res);
  23     return Encode::decode('euc-jp', $res, $chk);
  24 }
  25
  26 sub encode
  27 {
  28     my ($obj,$str,$chk) = @_;
  29     my $res = Encode::encode('euc-jp', $str, $chk);
  30     euc_jis(\$res);
  31     return $res;
  32 }
  33
  34 use Encode::CJKConstants qw(:all);
  35
  36 # JIS<->EUC
  37
  38 sub jis_euc {
  39     my $r_str = shift;
  40     $$r_str =~ s(
  41                  ($RE{JIS_0212}|$RE{JIS_0208}|$RE{ISO_ASC}|$RE{JIS_KANA})
  42                  ([^\e]*)
  43                  )
  44     {
  45         my ($esc, $str) = ($1, $2);
  46         if ($esc !~ /$RE{ISO_ASC}/o) {
  47             $str =~ tr/\x21-\x7e/\xa1-\xfe/;
  48             if ($esc =~ /$RE{JIS_KANA}/o) {
  49                 $str =~ s/([\xa1-\xdf])/\x8e$1/og;
  50             }
  51             elsif ($esc =~ /$RE{JIS_0212}/o) {
  52                 $str =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og;
  53             }
  54         }
  55         $str;
  56     }geox;
  57     $$r_str;
  58 }
  59
  60 sub euc_jis{
  61     my $r_str = shift;
  62     $$r_str =~ s{
  63         ((?:$RE{EUC_C})+|(?:$RE{EUC_KANA})+|(?:$RE{EUC_0212})+)
  64         }{
  65             my $str = $1;
  66             my $esc =
  67                 ( $str =~ tr/\x8E//d ) ? $ESC{KANA} :
  68                     ( $str =~ tr/\x8F//d ) ? $ESC{JIS_0212} :
  69                         $ESC{JIS_0208};
  70             $str =~ tr/\xA1-\xFE/\x21-\x7E/;
  71             $esc . $str . $ESC{ASC};
  72         }geox;
  73     $$r_str =~
  74         s/\Q$ESC{ASC}\E
  75             (\Q$ESC{KANA}\E|\Q$ESC{JIS_0212}\E|\Q$ESC{JIS_0208}\E)/$1/gox;
  76     $$r_str;
  77 }
  78
  79 sub euc_jis_nox0212{
  80     my $r_str = shift;
  81     $$r_str =~ s/$RE{EUC_0212}/$CHARCODE{UNDEF_EUC}/go;
  82     euc_jis($r_str);
  83 }
  84
  85 1;
  86 __END__