This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
394a7e62d3dc0c109513ad58e4feeb9890cd0015
[perl5.git] / 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 # Just for the time being, we implement jis-7bit
8 # encoding via EUC
9
10 my $canon = '7bit-jis';
11 my $obj = bless {name => $canon}, __PACKAGE__;
12 $obj->Define($canon);
13
14 sub decode
15 {
16     my ($obj,$str,$chk) = @_;
17     my $res = $str;
18     jis_euc(\$res);
19     return Encode::decode('euc-jp', $res, $chk);
20 }
21
22 sub encode
23 {
24     my ($obj,$str,$chk) = @_;
25     my $res = Encode::encode('euc-jp', $str, $chk);
26     euc_jis(\$res);
27     return $res;
28 }
29
30 use Encode::JP::Constants qw(:all);
31
32 # JIS<->EUC
33
34 sub jis_euc {
35     my $r_str = shift;
36     $$r_str =~ s(
37                  ($RE{JIS_0212}|$RE{JIS_0208}|$RE{JIS_ASC}|$RE{JIS_KANA})
38                  ([^\e]*)
39                  )
40     {
41         my ($esc, $str) = ($1, $2);
42         if ($esc !~ /$RE{JIS_ASC}/o) {
43             $str =~ tr/\x21-\x7e/\xa1-\xfe/;
44             if ($esc =~ /$RE{JIS_KANA}/o) {
45                 $str =~ s/([\xa1-\xdf])/\x8e$1/og;
46             }
47             elsif ($esc =~ /$RE{JIS_0212}/o) {
48                 $str =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og;
49             }
50         }
51         $str;
52     }geox;
53     $$r_str;
54 }
55
56 sub euc_jis{
57     my $r_str = shift;
58     $$r_str =~ s{
59         ((?:$RE{EUC_C})+|(?:$RE{EUC_KANA})+|(?:$RE{EUC_0212})+)
60         }{
61             my $str = $1;
62             my $esc = 
63                 ( $str =~ tr/\x8E//d ) ? $ESC{KANA} :
64                     ( $str =~ tr/\x8F//d ) ? $ESC{JIS_0212} :
65                         $ESC{JIS_0208};
66             $str =~ tr/\xA1-\xFE/\x21-\x7E/;
67             $esc . $str . $ESC{ASC};
68         }geox;
69     $$r_str =~
70         s/\Q$ESC{ASC}\E
71             (\Q$ESC{KANA}\E|\Q$ESC{JIS_0212}\E|\Q$ESC{JIS_0208}\E)/$1/gox;
72     $$r_str;
73 }
74
75 1;
76 __END__