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