Perl で UTF-16 のテキストファイル"も"読めるようにする

Perl でテキストファイルを読んで処理するプログラムを書いて使ってもらっていたところ、ある日突然エラーになるという報告が。そこにあったのは、UTF-16 (BOM 付き) のテキストファイルでした。つらい。

Windows では UTF-16 が使われることが多く、また、UTF-8 だったとしても BOM が付いていて、UNIX なテキスト処理のプログラムに入れるとまともに処理されないことがあります。ついでに改行コードが CRLF だったりもします。

自分を含めプログラマだけが使うプログラムであれば、UTF-8 と LF の組み合わせを前提にしても問題ないでしょう。しかし、非プログラマが使うとなると、なかなかそうも言っていられません。ファイルを作る時に気をつけてもらうという手も無くはないですが、たくさんの人が関わるようになると限界があるというのも確かなので、読み取る側でうまいことやって使う側は何も気にしなくて済むようにしよう、となるわけです。

標準モジュールの Encode::Guess がデータから文字コードを推測してくれるとのことだったので、試してみたのですがどうもうまく動きませんでした。はじめに推測した結果で読み進めていくのではなく、行を読むたびに推測しているっぽく、1行が短いとうまく推測できないんだと思います。

use Encode::Guess;

# 文字コードを推測して読む
open my $fh, '<:encoding(guess)', $ARGV[0] or die $!;

while (my $row = <$fh>) {
    $row =~ s/\r?\n$//; # CRLF 対策
    print "$row\n";
}

close $fh;

先頭をざっくり見て、推測させてから読んでいけばうまくいくのかなと思い試したのが以下のコードです。割と期待していたのですが、BOM 付きの UTF-16 として推測されると、2行目を読むときにも BOM を読み取ろうとしてエラーになってしまいました。全部まとめて decode すれば解決しそうな気はするものの、ファイルサイズが非常に大きい想定なのでそれはできそうにありません。

use Encode::Guess;

open my $fh, '<', $ARGV[0] or die $!;

# 先頭を読んで推測
read $fh, my $head, 1024 or die $!;
my $enc = Encode::Guess::guess_encoding($head);

seek $fh, 0, 0;

while (my $row = <$fh>) {
    $row = $enc->decode($row); # 推測した結果で decode
    $row =~ s/\r?\n$//;
    print "$row\n";
}

close $fh;

結局、Windows 環境で生成される ASCII 非互換のファイルはだいたいが BOM 付きの Unicode であることに着目し、自分で BOM を見てエンコーディングを設定するようにしました。対応する文字コードは限られるものの、対応する範囲については推測するよりも確実に動いてくれて安心感があります。

my %bom2enc = (
    "\xEF\xBB\xBF"     => 'utf-8',
    "\xFE\xFF"         => 'utf-16be',
    "\xFF\xFE"         => 'utf-16le',
    "\x00\x00\xFE\xFF" => 'utf-32be',
    "\xFF\xFE\x00\x00" => 'utf-32le',
);

open my $fh, '<', $ARGV[0] or die $!;

# 先頭4バイトを読む
read $fh, my $head, 4 or die $!;
# 追記 2016-03-12: 文字数の長い BOM に優先的にマッチするようにソートしておく
my $boms = join('|', sort { length($b) <=> length($a) } keys %bom2enc);
if ($head =~ /^($boms)/) {
    # BOM があればエンコーディングを設定
    my $bom = $1;
    binmode $fh, ":encoding($bom2enc{$bom})";
    # 先頭から BOM の分だけずらした位置に戻る
    seek $fh, length($bom), 0;
}
else {
    # 無ければ先頭に戻る
    seek $fh, 0, 0;
}

while (my $row = <$fh>) {
    $row =~ s/\r?\n$//;
    print "$row\n";
}

close $fh;

これで平和な世の中になるといいですね。

追記 2016-03-12

tyru さんから、BOM の候補を長い順にソートしておかないと出現順によっては BOM の一部が短いパターンにマッチしてしまう場合があるとのご指摘をいただいたため、コードを修正しました。