たまにunzipで解凍したファイルの名前が化けることがある。Shift_JISでもUTF-8でもEUC-JPでもISO-2022-JPでもない妙なコードになる。 たぶんunzipのバグでマルチバイトなファイル名の取り扱いに問題があるんだと思うが、さすがにCで書かれたものをおっかけてる暇も無い。

で、CPANを探したら Archive::Zip を見つけたので、 ここらへん とArchive::Zip(3pm)を見ながら適当に書いてみた。

#!/usr/bin/perl
use strict;
use warnings;
use utf8;

use Archive::Zip qw/:ERROR_CODES/;
use Encode::Guess qw/ascii euc-jp shiftjis 7bit-jis utf8/;
use File::Basename;
use File::Path;
use Term::ReadKey;

my $encoding = $ENV{LANG} =~ /euc-?jp/i ? 'euc-jp' : 'utf-8';
binmode STDOUT, ":encoding($encoding)";
binmode STDERR, ":encoding($encoding)";


my $file = $ARGV[0];
my $zip = new Archive::Zip;

$zip->read($file) == AZ_OK or die "Cannot read $file\n";

my $str;
foreach my $f ($zip->members)
{
    $str .= $f->fileName;
}

my $dec = Encode::Guess->guess($str);
ref $dec or die "Cannot recognize files charset\n";

ReadMode 3;

foreach my $f ($zip->members)
{
    my $utf8file = $dec->decode($f->fileName);
    my $outfile = Encode::encode($encoding, $utf8file);
    $outfile =~ s/\/\.\.+//g;

    my $outdir = dirname($outfile);
    mkpath $outdir if (!-d $outdir);

    if(-f $outfile) {
        print "$utf8file exist. overwrite?(Y/n)";
        my $char = ReadKey();
        if ($char eq 'n') {
            print "\n$utf8file skip!\n";
            next;
        }
    }
    print "extract " . $utf8file . " ...";
    $zip->extractMember($f->fileName, $outfile);
    print "done.\n";
}

むう、日記に張るにはちと長いかな。まあいいや。

とりあえずこれで普通に解凍できるってことは、zipファイルには問題無しだな。やっぱunzipのバグかー。どこにそんなバグあるんだろ。debianのsid環境なんだが、etchにも同じバージョン入ってるのかな。だとしたらリリース前にBTSしないとまずいかなあ。

しかし再現データ作れないんだよな……。Shift_JISのファイル名ってだけなら別に問題無いみたいだし……。

(@996)