1 package Encode
::JP
::JIS7
;
4 our $VERSION = do { my @r = (q
$Revision: 2.0 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
6 use Encode
qw(:fallbacks);
8 for my $name ('7bit-jis', 'iso-2022-jp', 'iso-2022-jp-1'){
9 my $h2z = ($name eq '7bit-jis') ?
0 : 1;
10 my $jis0212 = ($name eq 'iso-2022-jp') ?
0 : 1;
12 $Encode::Encoding
{$name} =
20 use base
qw(Encode::Encoding);
22 # we override this to 1 so PerlIO works
25 use Encode
::CJKConstants
qw(:all);
28 # decode is identical for all 2022 variants
33 my ($obj, $str, $chk) = @_;
36 $str =~ s/([^\x00-\x7f].*)$//so and $residue = $1;
38 $residue .= jis_euc
(\
$str);
39 $_[1] = $residue if $chk;
40 return Encode
::decode
('euc-jp', $str, FB_PERLQQ
);
49 require Encode
::JP
::H2Z
;
50 my ($obj, $utf8, $chk) = @_;
51 # empty the input string in the stack so perlio is ok
53 my ($h2z, $jis0212) = @
$obj{qw(h2z jis0212)};
54 my $octet = Encode
::encode
('euc-jp', $utf8, FB_PERLQQ
) ;
55 $h2z and &Encode
::JP
::H2Z
::h2z
(\
$octet);
56 euc_jis
(\
$octet, $jis0212);
63 my $re_scan_jis_g = qr{
64 \G
( ($RE{JIS_0212
}) | $RE{JIS_0208
} |
65 ($RE{ISO_ASC
}) | ($RE{JIS_KANA
}) | )
68 sub cat_decode
{ # ($obj, $dst, $src, $pos, $trm, $chk)
69 my ($obj, undef, undef, $pos, $trm) = @_; # currently ignores $chk
70 my ($rdst, $rsrc, $rpos) = \
@_[1,2,3];
73 my $opos = pos($$rsrc);
75 while ($$rsrc =~ /$re_scan_jis_g/gc) {
76 my ($esc, $esc_0212, $esc_asc, $esc_kana, $chunk) =
79 unless ($chunk) { $esc or last; next; }
81 if ($esc && !$esc_asc) {
82 $chunk =~ tr/\x21-\x7e/\xa1-\xfe/;
84 $chunk =~ s/([\xa1-\xdf])/\x8e$1/og;
86 $chunk =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og;
88 $chunk = Encode
::decode
('euc-jp', $chunk, 0);
90 elsif ((my $npos = index($chunk, $trm)) >= 0) {
91 $$rdst .= substr($chunk, 0, $npos + length($trm));
92 $$rpos += length($esc) + $npos + length($trm);
105 my $re_scan_jis = qr{
106 (?
:($RE{JIS_0212
})|$RE{JIS_0208
}|($RE{ISO_ASC
})|($RE{JIS_KANA
}))([^\e
]*)
112 $$r_str =~ s
($re_scan_jis)
114 my ($esc_0212, $esc_asc, $esc_kana, $chunk) =
117 $chunk =~ tr/\x21-\x7e/\xa1-\xfe/;
119 $chunk =~ s/([\xa1-\xdf])/\x8e$1/og;
122 $chunk =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og;
127 my ($residue) = ($$r_str =~ s/(\e.*)$//so);
132 no warnings
qw(uninitialized);
136 ((?
:$RE{EUC_C
})+|(?
:$RE{EUC_KANA
})+|(?
:$RE{EUC_0212
})+)
140 ( $chunk =~ tr/\x8E//d ) ?
$ESC{KANA
} :
141 ( $chunk =~ tr/\x8F//d ) ?
$ESC{JIS_0212
} :
143 if ($esc eq $ESC{JIS_0212
} && !$jis0212){
145 $chunk =~ tr/\xA1-\xFE/\x3F/;
147 $chunk =~ tr/\xA1-\xFE/\x21-\x7E/;
149 $esc . $chunk . $ESC{ASC
};
153 (\Q
$ESC{KANA
}\E
|\Q
$ESC{JIS_0212
}\E
|\Q
$ESC{JIS_0208
}\E
)/$1/gox;
163 Encode::JP::JIS7 -- internally used by Encode::JP