package Encode
::JP
::JIS7
;
our $VERSION = do { my @r = (q
$Revision: 2.0 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
use Encode
qw(:fallbacks);
for my $name ('7bit-jis', 'iso-2022-jp', 'iso-2022-jp-1'){
my $h2z = ($name eq '7bit-jis') ?
0 : 1;
my $jis0212 = ($name eq 'iso-2022-jp') ?
0 : 1;
$Encode::Encoding
{$name} =
use base
qw(Encode::Encoding);
# we override this to 1 so PerlIO works
use Encode
::CJKConstants
qw(:all);
# decode is identical for all 2022 variants
my ($obj, $str, $chk) = @_;
$str =~ s/([^\x00-\x7f].*)$//so and $residue = $1;
$residue .= jis_euc
(\
$str);
$_[1] = $residue if $chk;
return Encode
::decode
('euc-jp', $str, FB_PERLQQ
);
my ($obj, $utf8, $chk) = @_;
# empty the input string in the stack so perlio is ok
my ($h2z, $jis0212) = @
$obj{qw(h2z jis0212)};
my $octet = Encode
::encode
('euc-jp', $utf8, FB_PERLQQ
) ;
$h2z and &Encode
::JP
::H2Z
::h2z
(\
$octet);
euc_jis
(\
$octet, $jis0212);
\G
( ($RE{JIS_0212
}) | $RE{JIS_0208
} |
($RE{ISO_ASC
}) | ($RE{JIS_KANA
}) | )
sub cat_decode
{ # ($obj, $dst, $src, $pos, $trm, $chk)
my ($obj, undef, undef, $pos, $trm) = @_; # currently ignores $chk
my ($rdst, $rsrc, $rpos) = \
@_[1,2,3];
while ($$rsrc =~ /$re_scan_jis_g/gc) {
my ($esc, $esc_0212, $esc_asc, $esc_kana, $chunk) =
unless ($chunk) { $esc or last; next; }
$chunk =~ tr/\x21-\x7e/\xa1-\xfe/;
$chunk =~ s/([\xa1-\xdf])/\x8e$1/og;
$chunk =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og;
$chunk = Encode
::decode
('euc-jp', $chunk, 0);
elsif ((my $npos = index($chunk, $trm)) >= 0) {
$$rdst .= substr($chunk, 0, $npos + length($trm));
$$rpos += length($esc) + $npos + length($trm);
(?
:($RE{JIS_0212
})|$RE{JIS_0208
}|($RE{ISO_ASC
})|($RE{JIS_KANA
}))([^\e
]*)
$$r_str =~ s
($re_scan_jis)
my ($esc_0212, $esc_asc, $esc_kana, $chunk) =
$chunk =~ tr/\x21-\x7e/\xa1-\xfe/;
$chunk =~ s/([\xa1-\xdf])/\x8e$1/og;
$chunk =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og;
my ($residue) = ($$r_str =~ s/(\e.*)$//so);
no warnings
qw(uninitialized);
((?
:$RE{EUC_C
})+|(?
:$RE{EUC_KANA
})+|(?
:$RE{EUC_0212
})+)
( $chunk =~ tr/\x8E//d ) ?
$ESC{KANA
} :
( $chunk =~ tr/\x8F//d ) ?
$ESC{JIS_0212
} :
if ($esc eq $ESC{JIS_0212
} && !$jis0212){
$chunk =~ tr/\xA1-\xFE/\x3F/;
$chunk =~ tr/\xA1-\xFE/\x21-\x7E/;
$esc . $chunk . $ESC{ASC
};
(\Q
$ESC{KANA
}\E
|\Q
$ESC{JIS_0212
}\E
|\Q
$ESC{JIS_0208
}\E
)/$1/gox;
Encode::JP::JIS7 -- internally used by Encode::JP