あなたの天然記念物
ホーム更新雑談Perl鉄ゲタランドナーコースガイド自転車Linuxリンク経歴連絡先

Windowsで名前がUnicodeのファイルを開く方法 (2016.03.27)

背景

ブラウザで表示しているサイトのURLをドラッグ&ドロップでデスクトップに保存するとファイル名は「サイトのタイトル+.URL」になります。 このURLファイルをPerlのスクリプトから開いています。 タイトルに使っている文字が文字コードCP932(シフトJISの親戚)にないケースでは、Windows下のPerlのopenで開くことができません。

具体例

郵便局のマーク「〠」はCP932になくファイル名に使うとopenでは無理。 郵便局のマークをファイル名に使う

先駆者を探す

私が見るトラブルは、大抵、先駆者の皆さんがブログに解決策を上げてくれるので探します。 けれど今回のケースを見つけられませんでした。 検索していく中で、記事1件で書き逃げしたサイト(笑)が気になります。
WindowsでPerl 5.8/5.10を使うモンじゃない - hizumi
他所の言語へ行っちゃった人は放っておき、残ってるサンプルソースが興味深い。 同じ事をどうするかコードを書いてみました。

コード

2016.03.24 ファイルを変数に読まずPerlのファイルハンドルに割り当てるように改善しました。 ただし「use open IO => ":utf8";」が適用されずbinmodeでの文字コード指定が必要です。
#!/usr/local/bin/perl -w

use 5.10.1;
use utf8;
use strict;
use warnings;
use open IO => ":utf8";

use Encode;
use Encode::Argv ("cp932");
use Encode::Locale;
use Win32::FindFile;
use Win32API::File ":Func", ":FuncW", ":GENERIC_", ":Misc";

binmode STDOUT, ":encoding(cp932)";

$| = 1;

my ($pat, $path) = @ARGV;
for (grepdir($path)) {
	grepfile($pat, $_);
}

exit;



sub grepdir {
	my ($dir) = @_;
	my @files;
	for (grep {$_->{filename} !~ /^\..?/} map {{attr => $_->dwFileAttributes, filename => Encode::decode "utf8", $_->cFileName}} FindFile("$dir/*")) {
		print "!!$dir/$_->{filename}!!\n";
		if (0x10 & $_->{attr}) {
			push @files, grepdir("$dir/$_->{filename}");
		} elsif (0x20 & $_->{attr}) {
			push @files, "$dir/$_->{filename}";
		}
	}

	return @files;
}



sub grepfile {
	my ($pat, $file) = @_ ;
	my $in;
	if (win32_open_read($in, $file)) {
		binmode $in, ":encoding(utf8)";
		while (<$in>) {
			chomp;
			print "$file:$_\n" if /$pat/;
		}
		close $in;
	} else {
		print STDERR "Error:open($file):$!\n";
	}
}



sub win32_open_read {
	my ($junk, $filename) = @_;
	my $hFile = CreateFileW Encode::encode("utf-16le" => "$filename\0"), GENERIC_READ, 0, [], OPEN_EXISTING, 0, [];
	my $rc = 0;
	if ($hFile) {
		# WindowsのハンドルにPerlのファイルハンドルを割り当てる
		my $fh = IO::File->new();
		if (OsFHandleOpen($fh, $hFile, 0)) {
			# 第1パラメタにハンドルを書き戻す
			$_[0] = $fh;
			$rc = 1;
		} else {
			my $svError = Encode::decode locale => fileLastError();
			print STDERR "OsFHandleOpen失敗:$filename:$svError\n";

			CloseHandle($hFile);
		}
	} else {
		my $svError = Encode::decode locale => fileLastError();
		print STDERR "CreateFileW失敗:$filename:$svError\n";
	}

	return $rc;
}

フォルダ構成

C:━TEMP━TP━DT┳〠は郵便局のマーク┳〠.txt
        ┃         ┣alpha.txt
        ┃         ┗sjis.txt
        ┣alphabet┳alpha.txt
        ┃    ┗sjis.txt
        ┗日本語┳alpha.txt
            ┗sjis.txt

実行結果

コマンドプロンプトで実行する都合上、CP932にない文字を表示しようとしてエラーになっています。 〠の代わりに文字コードの16進形式\x{3020}が表示されています。
C:\TEMP\TP>perl grepdir_trial.pl aaa dt
!!dt/alphabet!!
!!dt/alphabet/alpha.txt!!
!!dt/alphabet/sjis.txt!!
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 32.
!!dt/\x{3020}は郵便局のマーク!!
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 32.
!!dt/\x{3020}は郵便局のマーク/alpha.txt!!
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 32.
!!dt/\x{3020}は郵便局のマーク/sjis.txt!!
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 32.
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 32.
!!dt/\x{3020}は郵便局のマーク/\x{3020}.txt!!
!!dt/日本語!!
!!dt/日本語/alpha.txt!!
!!dt/日本語/sjis.txt!!
dt/alphabet/alpha.txt:aaa
dt/alphabet/sjis.txt:aaa
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 51, <$_[...]> line 1.
dt/\x{3020}は郵便局のマーク/alpha.txt:aaa
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 51, <$_[...]> line 1.
dt/\x{3020}は郵便局のマーク/sjis.txt:aaa
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 51, <$_[...]> line 1.
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 51, <$_[...]> line 1.
dt/\x{3020}は郵便局のマーク/\x{3020}.txt:aaa
dt/日本語/alpha.txt:aaa
dt/日本語/sjis.txt:aaa

C:\TEMP\TP>perl grepdir_trial.pl 表 dt
!!dt/alphabet!!
!!dt/alphabet/alpha.txt!!
!!dt/alphabet/sjis.txt!!
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 32.
!!dt/\x{3020}は郵便局のマーク!!
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 32.
!!dt/\x{3020}は郵便局のマーク/alpha.txt!!
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 32.
!!dt/\x{3020}は郵便局のマーク/sjis.txt!!
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 32.
"\x{3020}" does not map to cp932 at grepdir_trial.pl line 32.
!!dt/\x{3020}は郵便局のマーク/\x{3020}.txt!!
!!dt/日本語!!
!!dt/日本語/alpha.txt!!
!!dt/日本語/sjis.txt!!

C:\TEMP\TP>

おまけ

2016.03.27 件のサイトは、cp932(シフトJIS)のファイル名を扱えれば良いので簡単だと気付きました。 変更のポイントは次の通り。
  1. ARGVの文字コードを自動変換
  2. 関数open、opendir、readdirをオーバーロード
  3. ファイルテスト演算子-fと-dはstatを呼ばないのでGetFileAttributesWに書き換え
  4. 標準出力と標準エラー出力の文字コードを自動変換

コード

#!perl -w

use subs "open", "opendir", "readdir";

use Encode;
use Encode::Argv ("cp932");
use Win32API::File ":FuncW", ":FILE_ATTRIBUTE_";

binmode STDOUT, ":encoding(cp932)";
binmode STDERR, ":encoding(cp932)";

&grepdir(@ARGV) ;

exit 0 ;
# ---------------------------------------
sub grepdir($$){
  my($pat,$dir) = @_ ;
  my($node) ;
  opendir(D,$dir) ;
  my @nodes = grep (!/^\./, readdir(D)) ;
  closedir(D) ;
  # -------------------------------------
  foreach $node (@nodes) {
    my $path="$dir/$node" ;
    print "!!$path!!\n" ;
    my $uAttrs = GetFileAttributesW Encode::encode("utf-16le" => "$path\0");
    if (FILE_ATTRIBUTE_ARCHIVE & fileattr($path)) {
      grepfile($pat,$path) ;
    }
    elsif(FILE_ATTRIBUTE_DIRECTORY & fileattr($path)) {
      &grepdir($pat,$path)
    }
    else {
      print STDERR "skip:$path\n" ;
    }
  }
}

sub grepfile($$){
  my($pat,$file) = @_ ;
  open(IN,$file) or die "Error:open($file):$!\n" ;
  while (<IN>) {
    chomp ;
    print "$file:$_\n" if (/$pat/) ;
  }
}



sub opendir {
	if (2 == @_) {
		return CORE::opendir $_[0], Encode::encode "cp932", $_[1];
	}
	return CORE::opendir $_[0], $_[1];
}



sub readdir {
	if (wantarray) {
		return map {Encode::decode "cp932", $_} CORE::readdir $_[0];
	}
	return CORE::readdir @_;
}



sub open {
	my $hFile;
	if (2 == @_) {
		return CORE::open $_[0], Encode::encode "cp932", $_[1];
	}
	return CORE::open @_;
}



sub fileattr {
	my ($path) = @_;
	my $uAttrs = GetFileAttributesW Encode::encode "utf-16le", "$path\0";
}

フォルダ構成

C:━TEMP━TP━DT┳alphabet┳alpha.txt
        ┃    ┗sjis.txt
        ┗日本語┳alpha.txt
            ┗sjis.txt

実行結果

C:\TEMP\TP>perl grepdir_override_simple.pl aaa dt
Name "main::IN" used only once: possible typo at grepdir_override_simple.pl line 41.
Name "main::D" used only once: possible typo at grepdir_override_simple.pl line 21.
!!dt/alphabet!!
!!dt/alphabet/alpha.txt!!
dt/alphabet/alpha.txt:aaa
!!dt/alphabet/sjis.txt!!
dt/alphabet/sjis.txt:aaa
!!dt/日本語!!
!!dt/日本語/alpha.txt!!
dt/日本語/alpha.txt:aaa
!!dt/日本語/sjis.txt!!
dt/日本語/sjis.txt:aaa

C:\TEMP\TP>perl grepdir_override_simple.pl 表 dt
Name "main::D" used only once: possible typo at grepdir_override_simple.pl line 21.
Name "main::IN" used only once: possible typo at grepdir_override_simple.pl line 41.
!!dt/alphabet!!
!!dt/alphabet/alpha.txt!!
!!dt/alphabet/sjis.txt!!
!!dt/日本語!!
!!dt/日本語/alpha.txt!!
!!dt/日本語/sjis.txt!!

C:\TEMP\TP>