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