Commit | Line | Data |
0e567a6c |
1 | package Encode::JP::JIS; |
2 | use Encode::JP; |
3 | use base 'Encode::Encoding'; |
4 | |
8f21750f |
5 | use strict; |
6 | |
64ffdd5e |
7 | our $VERSION = do { my @r = (q$Revision: 0.99 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; |
eb042f38 |
8 | |
0e567a6c |
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 | |
1b2c56c8 |
16 | sub name { return $_[0]->{name}; } |
17 | |
0e567a6c |
18 | sub decode |
19 | { |
20 | my ($obj,$str,$chk) = @_; |
21 | my $res = $str; |
22 | jis_euc(\$res); |
8f21750f |
23 | return Encode::decode('euc-jp', $res, $chk); |
0e567a6c |
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 | |
64ffdd5e |
34 | use Encode::CJKConstants qw(:all); |
0e567a6c |
35 | |
36 | # JIS<->EUC |
37 | |
38 | sub jis_euc { |
39 | my $r_str = shift; |
40 | $$r_str =~ s( |
64ffdd5e |
41 | ($RE{JIS_0212}|$RE{JIS_0208}|$RE{ISO_ASC}|$RE{JIS_KANA}) |
0e567a6c |
42 | ([^\e]*) |
43 | ) |
44 | { |
45 | my ($esc, $str) = ($1, $2); |
64ffdd5e |
46 | if ($esc !~ /$RE{ISO_ASC}/o) { |
0e567a6c |
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 | |
a63c962f |
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 | |
0e567a6c |
85 | 1; |
86 | __END__ |