Win32API::File 0.1001向けのパッチ
最終的なworkaroundとして紹介されたWin32API::File、RTにも投げてあるし、ppmパッケも作ってあるけど、とりあえずいまの最新版をCPANから日本語環境にインストールしようとするとこけるので、file.tにこんなパッチをあててからインストールすると吉。テストを気にしないならforceしてもいい。
diff -ur Win32API-File-0.1001/t/file.t Win32API-File-0.1001-patched/t/file.t --- Win32API-File-0.1001/t/file.t 2006-06-30 22:47:43.000000000 +0900 +++ Win32API-File-0.1001-patched/t/file.t 2007-05-10 12:44:27.344875000 +0900 @@ -24,6 +24,12 @@ $ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR}; +sub ERROR_FILE_NOT_FOUND () { 2 }; +sub ERROR_ACCESS_DENIED () { 5 }; +sub ERROR_INVALID_HANDLE () { 6 }; +sub ERROR_FILE_EXISTS () { 80 }; +sub ERROR_ALREADY_EXISTS () { 183 }; + chdir( $temp ) or die "# Can't cd to temp directory, $temp: $!\n"; @@ -43,49 +49,49 @@ or die "# Can't cd to my dir, $temp/$dir: $!\n"; $h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } ); -$ok= ! $h1 && fileLastError() =~ /not find the file?/i; -$ok or print "# ","".fileLastError(),"\n"; +$ok= ! $h1 && 0+fileLastError() == ERROR_FILE_NOT_FOUND; # not find the file +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 2 if( ! $ok ) { CloseHandle($h1); unlink("ReadOnly.txt"); } $ok= $h1= createFile( "ReadOnly.txt", "wcn", { Attributes=>"r" } ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 3 $ok= WriteFile( $h1, "Original text\n", 0, [], [] ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 4 $h2= createFile( "ReadOnly.txt", "rcn" ); -$ok= ! $h2 && fileLastError() =~ /file exists?/i; -$ok or print "# ",fileLastError(),"\n"; +$ok= ! $h2 && 0+fileLastError() == ERROR_FILE_EXISTS; # file exists; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 5 if( ! $ok ) { CloseHandle($h2); } $h2= createFile( "ReadOnly.txt", "rwke" ); -$ok= ! $h2 && fileLastError() =~ /access is denied?/i; -$ok or print "# ",fileLastError(),"\n"; +$ok= ! $h2 && 0+fileLastError() == ERROR_ACCESS_DENIED; # access is denied +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 6 if( ! $ok ) { CloseHandle($h2); } $ok= $h2= createFile( "ReadOnly.txt", "r" ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 7 $ok= SetFilePointer( $h1, length("Original"), [], FILE_BEGIN ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 8 $ok= WriteFile( $h1, "ly was other text\n", 0, $len, [] ) && $len == length("ly was other text\n"); $ok or print "# <$len> should be <", - length("ly was other text\n"),">: ",fileLastError(),"\n"; + length("ly was other text\n"),">: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 9 $ok= ReadFile( $h2, $text, 80, $len, [] ) && $len == length($text); $ok or print "# <$len> should be <",length($text), - ">: ",fileLastError(),"\n"; + ">: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 10 $ok= $text eq "Originally was other text\n"; @@ -96,31 +102,31 @@ print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 11 $ok= CloseHandle($h2); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 12 $ok= ! ReadFile( $h2, $text, 80, $len, [] ) - && fileLastError() =~ /handle is invalid?/i; -$ok or print "# ",fileLastError(),"\n"; + && 0+fileLastError() == ERROR_INVALID_HANDLE; # handle is invalid +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 13 CloseHandle($h1); $ok= $h1= createFile( "CanWrite.txt", "rw", FILE_SHARE_WRITE, { Create=>CREATE_ALWAYS } ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 14 $ok= WriteFile( $h1, "Just this and not this", 10, [], [] ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 15 $ok= $h2= createFile( "CanWrite.txt", "wk", { Share=>"rw" } ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 16 $ok= OsFHandleOpen( "APP", $h2, "wat" ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 17 $ok= $h2 == GetOsFHandle( "APP" ); @@ -129,13 +135,13 @@ { my $save= select(APP); $|= 1; select($save); } $ok= print APP "is enough\n"; -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 19 SetFilePointer($h1, 0, [], FILE_BEGIN) if $^O eq 'cygwin'; $ok= ReadFile( $h1, $text, 0, [], [] ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 20 $ok= $text eq "is enough\r\n"; @@ -163,56 +169,56 @@ CloseHandle( $h1 ); $ok= ! DeleteFile( "ReadOnly.txt" ) - && fileLastError() =~ /access is denied?/i; -$ok or print "# ",fileLastError(),"\n"; + && 0+fileLastError() == ERROR_ACCESS_DENIED; # access is denied +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 23 $ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 ) - && fileLastError() =~ /file exists?/i; -$ok or print "# ",fileLastError(),"\n"; + && 0+fileLastError() == ERROR_FILE_EXISTS; # file exists +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 24 $ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 ) - && fileLastError() =~ /access is denied?/i; -$ok or print "# ",fileLastError(),"\n"; + && 0+fileLastError() == ERROR_ACCESS_DENIED; # access is denied +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 25 $ok= ! MoveFile( "NoSuchFile", "NoSuchDest" ) - && fileLastError() =~ /not find the file/i; -$ok or print "# ",fileLastError(),"\n"; + && 0+fileLastError() == ERROR_FILE_NOT_FOUND; # not find the file +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 26 $ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 ) - && fileLastError() =~ /not find the file/i; -$ok or print "# ",fileLastError(),"\n"; + && 0+fileLastError() == ERROR_FILE_NOT_FOUND; # not find the file +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 27 $ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" ) - && fileLastError() =~ /file already exists?/i; -$ok or print "# ",fileLastError(),"\n"; + && 0+fileLastError() == ERROR_ALREADY_EXISTS; # file already exists +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 28 $ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 ) - && fileLastError() =~ /file already exists?/i; -$ok or print "# ",fileLastError(),"\n"; + && 0+fileLastError() == ERROR_ALREADY_EXISTS; # file already exists +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 29 $ok= CopyFile( "ReadOnly.txt", "ReadOnly.cp", 1 ) && CopyFile( "CanWrite.txt", "CanWrite.cp", 1 ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 30 $ok= ! MoveFileEx( "CanWrite.txt", "ReadOnly.cp", MOVEFILE_REPLACE_EXISTING ) - && fileLastError() =~ /access is denied?|cannot create/i; -$ok or print "# ",fileLastError(),"\n"; + && 0+fileLastError() == ERROR_ACCESS_DENIED; # access is denied (cannot create -- which error?) +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 31 $ok= MoveFileEx( "ReadOnly.cp", "CanWrite.cp", MOVEFILE_REPLACE_EXISTING ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 32 $ok= MoveFile( "CanWrite.cp", "Moved.cp" ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 33 $ok= ! unlink( "ReadOnly.cp" ) @@ -223,14 +229,14 @@ print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 34 $ok= ! DeleteFile( "Moved.cp" ) - && fileLastError() =~ /access is denied?/i; -$ok or print "# ",fileLastError(),"\n"; + && 0+fileLastError() == ERROR_ACCESS_DENIED; # access is denied; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35 system( "attrib -r Moved.cp" ); $ok= DeleteFile( "Moved.cp" ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 36 $new= SEM_FAILCRITICALERRORS|SEM_NOOPENFILEERRORBOX; @@ -239,21 +245,21 @@ $reold= SetErrorMode( $old ); $ok= $old == $reold; -$ok or print "# $old != $reold: ",fileLastError(),"\n"; +$ok or print "# $old != $reold: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 37 $ok= ($renew&$new) == $new; -$ok or print "# $new != $renew: ",fileLastError(),"\n"; +$ok or print "# $new != $renew: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 38 $ok= @drives= getLogicalDrives(); $ok && print "# @drives\n"; -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 39 $ok= $drives[0] !~ /^[ab]/ || DRIVE_REMOVABLE == GetDriveType($drives[0]); $ok or print "# ",DRIVE_REMOVABLE," != ",GetDriveType($drives[0]), - ": ",fileLastError(),"\n"; + ": ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 40 $drive= substr( $ENV{WINDIR}, 0, 3 ); @@ -264,17 +270,17 @@ $ok= DRIVE_FIXED == GetDriveType( $drive ); $ok or print - "# ",DRIVE_FIXED," != ",GetDriveType($drive),": ",fileLastError(),"\n"; + "# ",DRIVE_FIXED," != ",GetDriveType($drive),": ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 42 $ok= GetVolumeInformation( $drive, $vol, 64, $ser, $max, $flag, $fs, 16 ); -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 43 $vol= $ser= $max= $flag= $fs= ""; # Prevent warnings. chop($drive); $ok= QueryDosDevice( $drive, $dev, 80 ); -$ok or print "# $drive: ",fileLastError(),"\n"; +$ok or print "# $drive: ","".fileLastError(),"(",0+fileLastError(),")\n"; if( $ok ) { ( $text= $dev ) =~ s/\0/\\0/g; print "# $drive => $text\n"; @@ -292,17 +298,17 @@ print "# Querying undefined $let.\n"; $ok= DefineDosDevice( 0, $let, $ENV{WINDIR} ); -$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n"; +$ok or print "# $let,$ENV{WINDIR}: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 45 $ok= -s $let."/Win.ini" == -s $ENV{WINDIR}."/Win.ini"; $ok or print "# ", -s $let."/Win.ini", " vs. ", - -s $ENV{WINDIR}."/Win.ini", ": ",fileLastError(),"\n"; + -s $ENV{WINDIR}."/Win.ini", ": ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 46 $ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE, $let, $ENV{WINDIR} ); -$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n"; +$ok or print "# $let,$ENV{WINDIR}: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 47 $ok= ! -f $let."/Win.ini" @@ -313,37 +319,37 @@ $ok= DefineDosDevice( DDD_RAW_TARGET_PATH, $let, $dev ); if( !$ok ) { ( $text= $dev ) =~ s/\0/\\0/g; - print "# $let,$text: ",fileLastError(),"\n"; + print "# $let,$text: ","".fileLastError(),"(",0+fileLastError(),")\n"; } print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 49 $ok= -f $let.substr($ENV{WINDIR},3)."/win.ini"; -$ok or print "# ",fileLastError(),"\n"; +$ok or print "# ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 50 $ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE |DDD_RAW_TARGET_PATH, $let, $dev ); -$ok or print "# $let,$dev: ",fileLastError(),"\n"; +$ok or print "# $let,$dev: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 51 my $path = $ENV{WINDIR}; my $attrs = GetFileAttributes( $path ); $ok= $attrs != INVALID_FILE_ATTRIBUTES; -$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n"; +$ok or print "# $path gave invalid attribute value, attrs=$attrs: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 52 $ok= ($attrs & FILE_ATTRIBUTE_DIRECTORY); -$ok or print "# $path not a directory, attrs=$attrs: ",fileLastError(),"\n"; +$ok or print "# $path not a directory, attrs=$attrs: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 53 $path .= "/win.ini"; $attrs = GetFileAttributes( $path ); $ok= $attrs != INVALID_FILE_ATTRIBUTES; -$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n"; +$ok or print "# $path gave invalid attribute value, attrs=$attrs: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 54 $ok= !($attrs & FILE_ATTRIBUTE_DIRECTORY); -$ok or print "# $path is a directory, attrs=$attrs: ",fileLastError(),"\n"; +$ok or print "# $path is a directory, attrs=$attrs: ","".fileLastError(),"(",0+fileLastError(),")\n"; print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 55 # DefineDosDevice