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
CommitLineData
0e567a6c
JH
1package Encode::JP::JIS;
2use Encode::JP;
3use base 'Encode::Encoding';
4
8f21750f
JH
5use strict;
6
eb042f38
JH
7use vars qw($VERSION);
8$VERSION = 0.01;
9
0e567a6c
JH
10# Just for the time being, we implement jis-7bit
11# encoding via EUC
12
13my $canon = '7bit-jis';
14my $obj = bless {name => $canon}, __PACKAGE__;
15$obj->Define($canon);
16
17sub decode
18{
19 my ($obj,$str,$chk) = @_;
20 my $res = $str;
21 jis_euc(\$res);
8f21750f 22 return Encode::decode('euc-jp', $res, $chk);
0e567a6c
JH
23}
24
25sub 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
33use Encode::JP::Constants qw(:all);
34
35# JIS<->EUC
36
37sub 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
59sub 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
781;
79__END__