1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
package Encode::JIS2K::2022JP3;
use strict;
our $VERSION = do { my @r = (q$Revision: 0.03 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
use Encode qw(:fallbacks);
use base qw(Encode::Encoding);
my $Canon = 'iso-2022-jp-3';
$Encode::Encoding{$Canon} =
bless {
Name => $Canon,
h2z => 1,
jis0212 => 1,
} => __PACKAGE__;
# we override this to 1 so PerlIO works
sub needs_lines { 1 }
use Encode::CJKConstants qw(:all);
our $DEBUG = 0;
#
# decode is identical for all 2022 variants
#
sub decode($$;$)
{
my ($obj, $str, $chk) = @_;
my $residue = '';
if ($chk){
$str =~ s/([^\x00-\x7f].*)$//so;
$1 and $residue = $1;
}
$residue .= jis_euc(\$str);
$_[1] = $residue if $chk;
return Encode::decode('euc-jisx0213', $str, FB_PERLQQ);
}
#
# encode is different
#
sub encode($$;$)
{
require Encode::JP::H2Z;
my ($obj, $utf8, $chk) = @_;
# empty the input string in the stack so perlio is ok
$_[1] = '' if $chk;
my ($h2z, $jis0212) = @$obj{qw(h2z jis0212)};
my $octet = Encode::encode('euc-jisx0213', $utf8, FB_PERLQQ) ;
$h2z and &Encode::JP::H2Z::h2z(\$octet);
euc_jis(\$octet, $jis0212);
return $octet;
}
our $ESC_JISX0213_1 = "\e\$(O";
our $ESC_JISX0213_2 = "\e\$(P";
# JIS<->EUC
sub jis_euc {
my $r_str = shift;
$$r_str =~ s(
($RE{JIS_0212}|$RE{JIS_0208}|$RE{ISO_ASC}|$RE{JIS_KANA})
([^\e]*)
)
{
my ($esc, $chunk) = ($1, $2);
if ($esc !~ /$RE{ISO_ASC}/o) {
$chunk =~ tr/\x21-\x7e/\xa1-\xfe/;
if ($esc =~ /$RE{JIS_KANA}/o) {
$chunk =~ s/([\xa1-\xdf])/\x8e$1/og;
}
elsif ($esc =~ /$RE{JIS_0212}/o) {
$chunk =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og;
}
}
$chunk;
}geox;
my ($residue) = ($$r_str =~ s/(\e.*)$//so);
return $residue;
}
sub euc_jis{
no warnings qw(uninitialized);
my $r_str = shift;
my $jis0212 = shift;
$$r_str =~ s{
((?:$RE{EUC_C})+|(?:$RE{EUC_KANA})+|(?:$RE{EUC_0212})+)
}{
my $chunk = $1;
my $esc =
( $chunk =~ tr/\x8E//d ) ? $ESC{KANA} :
( $chunk =~ tr/\x8F//d ) ? $ESC_JISX0213_2 :
$ESC_JISX0213_1;
if ($esc eq $ESC_JISX0213_2 && !$jis0212){
# fallback to '?'
$chunk =~ tr/\xA1-\xFE/\x3F/;
}else{
$chunk =~ tr/\xA1-\xFE/\x21-\x7E/;
}
$esc . $chunk . $ESC{ASC};
}geox;
$$r_str =~
s/\Q$ESC{ASC}\E
(\Q$ESC{KANA}\E|\Q$ESC_JISX0213_1\E|\Q$ESC_JISX0213_2\E)/$1/gox;
$$r_str;
}
1;
__END__
=head1 NAME
Encode::JIS2K::2022JP3 -- internally used by Encode::JIS2K
=cut
|
