2006年12月13日水曜日

[Perl] Jcode.pm の文字コード自動判定

euc-jp のASCII の一部とIBM拡張文字92区の一部を組み合わせると sjis と誤判定されているようなので調べてメモ。

・ASCII文字
@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~
・IBM拡張文字92区
髙髜魵魲鮏鮱鮻鰀鵰鵫鶴鸙黑ⅰⅱⅲⅳⅴⅵⅶⅷⅸⅹ¬¦'"
例えばEUCの「@髙」を Jcode->new($str)->utf8; なんてことをやると、$str を SJIS と判定し、SJISからUTF-8変換してしまうので、文字化けしてしまう。

Jcode->new すると getcode で文字コードを判定し、convert で euc に変換している。
Jcode.pm
sub new {
my $class = shift;
my ($thingy, $icode) = @_;
my $r_str = ref $thingy ? $thingy : \$thingy;
my $nmatch;
($icode, $nmatch) = getcode($r_str) unless $icode;
convert($r_str, 'euc', $icode);
my $self = [
$r_str,
$icode,
$nmatch,
];
carp "Object of class $class created" if $DEBUG >= 2;
bless $self, $class;
}
なので、例えば
my $text = qq{ASCII,漢字、全角カタカナ、半角カタカナ、ひらがなの混じったtext};
$text = Jcode->new($text)->utf8;
で、変換前の $text が sjis の場合

getcode で $text 文字コードを判定
sjis => euc 変換
euc => utf8 変換

と処理される。変換元コードが判っていれば

Jcode::convert(\$str, 'sjis', 'utf8');

だけで済むので、前に調べたように性能差が出てくるのだろう。

自動判定で、どの文字コードに判定されているのかを調べるには
my ($icode, $nmatch) = Jcode::getcode($text);
と書けば、$icode に
binary
ascii
jis
euc
sjis
utf8
undef
の何れかが代入される。Jcode の誤判定の疑いがあるときなんかは、これでdebugする。euc-jp のIBM拡張文字115区+ASCII の文字列については、
use strict;
use warnings;
use Jcode;
my $text = qq{ⅲisoya9};
my ($icode, $nmatch) = Jcode::getcode($title);
print "icode is $icode nmatch is $nmatch\n";
これを実行すると
icode is sjis nmatch is 4
と sjis と判定されているようだ。判定ロジックは以下の通り(抜粋)。
Jcode.pm
sub getcode {
my $thingy = shift;
my $r_str = ref $thingy ? $thingy : \$thingy;
��
��
else { # should be euc|sjis|utf8
$sjis += length($1)
while $$r_str =~ /((?:$RE{SJIS_C})+)/go;
$euc += length($1)
while $$r_str =~ /((?:$RE{EUC_C}|$RE{EUC_KANA}|$RE{EUC_0212})+)/go;
$utf8 += length($1)
while $$r_str =~ /((?:$RE{UTF8})+)/go;
$nmatch = _max($utf8, $sjis, $euc);
carp ">DEBUG:sjis = $sjis, euc = $euc, utf8 = $utf8" if $DEBUG >= 3;
$code =
($euc > $sjis and $euc > $utf8) ? 'euc' :
($sjis > $euc and $sjis > $utf8) ? 'sjis' :
($utf8 > $euc and $utf8 > $sjis) ? 'utf8' : undef;
}
return wantarray ? ($code, $nmatch) : $code;
}
��
��
sub _max {
my $result = shift;
for my $n (@_){
$result = $n if $n > $result;
}
return $result;
}

Jcode::Constants.pm
%RE =
(
ASCII => '[\x00-\x7f]',
BIN => '[\x00-\x06\x7f\xff]',
EUC_0212 => '\x8f[\xa1-\xfe][\xa1-\xfe]',
EUC_C => '[\xa1-\xfe][\xa1-\xfe]',
EUC_KANA => '\x8e[\xa1-\xdf]',
JIS_0208 => "$_0208{1978}|$_0208{1983}|$_0208{1990}",
JIS_0212 => "\e" . '\$\(D',
JIS_ASC => "\e" . '\([BJ]',
JIS_KANA => "\e" . '\(I',
SJIS_C => '[\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc]',
SJIS_KANA => '[\xa1-\xdf]',
UTF8 => '[\xc0-\xdf][\x80-\xbf]|[\xe0-\xef][\x80-\xbf][\x80-\xbf]'
);


0 件のコメント: