私は非常に奇妙な行動に遭遇しています。
私のPerlプログラムはWindows上のいくつかのファイルを閉じようとしています。ファイルが閉じないことが判明しました-そしてエラーメッセージはありません。
ファイルが閉じられないことをどうやって知ることができますか？それらでPerlの「move」関数を実行しようとすると、エラーが発生するためです。
$!:許可が拒否されました
$ ^ E：ファイルが別のプロセスによって使用されているため、プロセスはファイルにアクセスできません
このプログラムを2台の異なるコンピューターでテストしました。1台はWindowsXPSP 3を実行し、もう1台はWindows7を実行しています。同じ結果が得られました。
Windowsの「handle.exe」ユーティリティを使用してファイルを「クローバー」すると、ファイルが閉じられ、ファイルを「移動」（名前変更）できます。
（この質問が長くなって申し訳ありませんが、そうでない場合、回答者は問題を理解するのに十分な詳細がないと言うかもしれません）。
コード例は次のとおりです。
このプログラムでは、ユーザーが「yes」「force_close」を選択すると、サブforce_closeが呼び出され、ファイルは閉じられます。ユーザーが「no」を選択した場合、これら2つの* .csvファイルで「close」関数を呼び出すのはPerlプログラムだけであり、実際には開いたままです。（「閉じる」はエラーなしで戻ります！）
重要な注意：他のプロセスがファイルを使用したり、ファイルを開いたままにしたりすることはありません。（どちらも「アンチウイルス」の可能性はありません）。どうすればわかりますか？「force_close」サブルーチンはファイルを閉じることに成功するため、perl.exeプロセスに接続された単一のWindowsハンドルを使用します。別のプロセスがファイルを開いたままにしていた場合、そのファイルには追加の開いたハンドルが必要であり、Perlの「移動」機能は失敗します。
注釈：a。ファイル情報は、（ファイル名に加えて）ファイルハンドルとモードを含む単純なハッシュで保持されます。
b。サブルーチンYNChoiceは、単純なラジオボタンのyes/no選択ウィンドウです。
メインプログラム：
use strict;
use warnings;
use 5.014;
use Win32::GUI();
use Win32::Console;
use autodie;
use warnings qw< FATAL utf8 >;
use Carp;
use Carp::Always;
use File::Copy;
use File::stat;
use English '-no_match_vars';
my ($i, $j, $k, $sta, $desk, $dw, $dh, $filename, $filename_old, $MovedFileName, $resname_new,
$resH, $inpH, $TopDir, $InputDir, $pid, $stobj, $fmode, $debug, $forceclose_choice);
my $NL = "\x0A";
my ( %inp_file, %res_file, %log);
sub force_close;
state $prog_name = substr( ProgName(), rindex(ProgName(), '\\')+1);
binmode STDOUT, ':unix:utf8';
binmode STDERR, ':unix:utf8';
binmode $DB::OUT, ':unix:utf8' if $DB::OUT; # for the debugger
Win32::Console::OutputCP(65001); # Set the console code page to UTF8
$debug = TRUE;
$TopDir = 'E:\My Documents\Technical\Perl\Eclipse workspace';
$desk = Win32::GUI::GetDesktopWindow();
$dw = Win32::GUI::Width($desk);
$dh = Win32::GUI::Height($desk);
$InputDir = Win32::GUI::BrowseForFolder( -root => $TopDir, -includefiles => 1,
-title => 'Select directory for file to rename', -newui => 1,
-text =>'text Select directory for file', -size => [60/100*$dw, 60/100*$dh],
-position => [50/100*$dw, 50/100*$dh], -owner =>$desk);
$log{FileName} = $InputDir.'\Close file test log '.DatenTime().'.txt';
$i = OpenFile \%log, ">:encoding(utf8)", # Must open log.txt explicitly
TimeString().SP.ProgName().": opening file: \n".$log{FileName};
if ($i) {
PrintT $log{HANDLE}, TimeString().SP.ProgName().": opened file '$log{FileName}'";
} # end if ($i)
binmode $i, ':unix:utf8';
# Select test file to open
$filename = Win32::GUI::GetOpenFileName( -title => 'Select file to open and close with handle',
-directory => $InputDir, -file => "\0" . " " x 256,
-filter => ["All files", "*.*", "Text files (*.txt)" => "*.txt",],
-text => 'Select file');
$inp_file{FileName} = $filename;
$inpH = OpenFile \%inp_file, "<:encoding(utf8)",
TimeString().SP.$prog_name.": opening file:\n'$inp_file{FileName};";
binmode $inpH, ':unix:utf8';
if ($inpH) { #1
say ": opened file:\n'$inp_file{FileName}'";
} # end if ($inpH)
else { #1
confess "Opening file '$inp_file{FileName}' failed";
} #1 end else if ($inpH)
$j = rindex $inp_file{FileName}, '.';
$res_file{FileName} = substr($inp_file{FileName}, 0, $j).' res.csv';
$resH = OpenFile \%res_file, '>:encoding(utf8)',
": opening \$res_file for output:\n'$res_file{FileName}'";
binmode $resH, ':unix:utf8';
local $/ = "\x0D\x0A";
while (<$inpH>) { #1
chomp;
$i = $_;
s{^(.*)(?<!\x0D)\x0A(.*)$}{$1$2}g; # delete newlines not preceded by cr
# See http://stackoverflow.com/questions/11391721
# and http://perldoc.perl.org/perlport.html#Newlines
$i = $_;
PrintT $resH, $_;
} #1 end while (<$inpH>)
CloseFile \%inp_file, TimeString(), SP, $prog_name, ": closing file: \n",
$inp_file{FileName};
CloseFile \%res_file, TimeString(), SP, $prog_name, ": closing file: \n", $res_file{FileName};
${^WIN32_SLOPPY_STAT} = TRUE; # see http://perldoc.perl.org/perlport.html#stat
$stobj = stat $inp_file{FileName};
$fmode = sprintf "%04o", $stobj->mode & 07777;
say ": for file \$inp_file{FileName}:\n'$inp_file{FileName}'\n",
'Mode is: ', $fmode, ', $stobj->mode = ', $stobj->mode;
$forceclose_choice = YNChoice Question => 'force_close $inp_file and $res_file?',
Debug => $debug, SizeRef => [30,15], LogRef => \%log;
if ($forceclose_choice) { #1
$pid = $PID;
force_close FileName => $inp_file{FileName}, owning_process => $pid, LogRef => \%log,
Debug => $debug;
} #1
$filename_old = substr($inp_file{FileName}, 0, $j).' old.csv';
say ": moving file:\n", "'$inp_file{FileName}' to:\n", "'$filename_old'\n";
$sta = move $inp_file{FileName}, $filename_old;
unless ($sta) { #1
confess "\n", $prog_name, ": problem renaming incoming file to '*.old'\n",
"\$!: $!\n", "\$^E: $^E";
} #1 end unless ($sta)
else { PrintDebug $debug, \%log, $prog_name, ': moving succeeded'; }
$resname_new = substr($inp_file{FileName}, 0, $j).'.csv'; # the original incoming filename
$inp_file{FileName} = $filename_old;
if ($forceclose_choice) { #1
force_close FileName => $res_file{FileName}, owning_process => $pid, LogRef => \%log,
Debug => $debug;
} #1
say ": renaming file:\n", "'$res_file{FileName}' to:\n", "'$resname_new'\n";
$sta = move $res_file{FileName}, $resname_new;
unless ($sta) { #1
confess $prog_name, ": problem renaming ResFile to original\n", "\$!: $!\n", "\$^E: $^E";
} #1 end unless ($sta)
else { say ': moving succeeded'; }
$res_file{FileName} = $resname_new;
サブルーチンOpenFileおよびCloseFile：
sub OpenFile { # Call: OpenFile \%FileStruct, $Mode, $Message [,$Message ...];
my ($FileRef, $Mode) =@_[0..1];
my ($HANDLE, $FileName, $sta);
$FileName = $FileRef->{FileName};
if (@_ >=3) { #1
foreach (@_[2..(scalar @_-1)]) { #2
print $_;
} #2 end foreach (@_[2..(scalar @_ -1)])
print "\n";
} #1 end if (@_ >=3)
unless ( defined $FileName) { confess 'Utilities::OpenFile: $FileName undefined';}
elsif ($Mode =~ m{.*<.*}) { #1
unless (-e $FileName) { #2
confess "Utilities::OpenFile: file '$FileName' does not exist'";
} #2 end unless (-e $FileName)
} #1 end elsif (! defined $FileName)
unless ( defined $FileRef->{HANDLE} and defined openhandle($FileRef->{HANDLE})
and defined $FileRef->{Mode} and ($FileRef->{Mode} =~ m{^.*<.*$})) { #1
$sta = open ($HANDLE, $Mode, $FileName);
if ($sta) { #2
$FileRef->{HANDLE} = $HANDLE;
$FileRef->{Mode} = $Mode;
} else { #2
confess "Can't open \$HANDLE: file:\n'$FileName'\n\$!: $!\n\$^E: $^E";
} #2 end else if ! $sta
} #1 end unless (if not) file is open
else { #1 file is open
say ' called from ', CallerName(),': file ', $FileRef->{FileName},' is open';
$sta = TRUE;
} #1 end else file is open
return ($sta ? $HANDLE : $sta);
} # end sub OpenFile
sub CloseFile { # Call: CloseFile \%FileStruct, $Message [,$Message ...];
my $FileRef = shift;
my ($HANDLE, $FileName, $sta);
$FileName = $FileRef->{FileName};
if (@_ >=1) { #1 There is a message
foreach (@_) { #2
print $_;
} #2 end foreach (@_[1..(scalar @_ -1)])
print "\n";
} #1 end if (@_ >=3)
unless (-e $FileName) { #1
confess SubName().": file '$FileName' does not exist'";
} #1 end unless (-e $FileName)
unless ( defined $FileName) { confess SubName().': $FileName undefined';}
unless (defined openhandle($FileRef->{HANDLE})) { #1
say ": file $FileName is closed!";
$sta = 0;
} else { #1
$sta = close $FileRef->{HANDLE};
unless ( $sta) { #2
confess "Can't close \$HANDLE: file:\n'$FileName'\n\$!: $!\n\$^E: $^E";
} else { #2
undef $FileRef->{Mode};
} #2 end else $sta
} #1 end else defined handle
return $sta;
} # end sub CloseFile
サブルーチンforce_close：
sub force_close { # close $FileStruct{FileName} using MS handle -------------------- force_close
# call: $sta = force_close FileName => $file_name, owning_process => $pid, LogRef = \%Log,
# Debug = $debug;
my %parms = @_;
my ($i, $j, $sta, $stobj, $fmode, $HANDLE, $command, $pid, $Windows_handle, $filename,
$filename_reg, $file_line, $lineno, $file_lineno, $s1succ, $s2succ);
my @handle_output;
state $handleloc = '"E:\\WinXP Programs\\System\\Utilities\\handle"'; #Location of MS handle.exe
local $/ = "\x0A";
# get all open files for the perl process
$pid = $parms{owning_process};
$filename = $parms{FileName};
$filename_reg = qr{\Q$filename\E};
$sta = open $command, "$handleloc -p $pid |";
unless ($sta) { #1
confess "\n", SubName(), ': problem invoking handle command',
"\$!: $!\n", "\$^E: $^E";
} #1 end unless ($sta)
$lineno = 0;
while (<$command>) {
chomp;
$j = $_;
if (m{$filename_reg} ) {
$file_line = $_;
$file_lineno = $lineno;
} # end if (m{$filename_reg} )
push @handle_output, $_;
say "\$lineno = $lineno\n", $_;
++$lineno;
} # end while (<$command>)
close $command;
if (defined $file_line) { # 1
say ': found line with $parms{FileName}, no.:', $file_lineno, ", Line:\n'$file_line'";
# get handle number for the file we want to close
$file_line =~ m{^\s*(\w+)\:};
unless (defined $1) { confess '$1 not defined'};
$Windows_handle = defined $1 ? $1 : '';
@handle_output = (); # release array
# force close the file
$sta = open $command, "$handleloc -c $Windows_handle -p $pid -y |";
unless ($sta) { #1
confess "\n", SubName(), ': problem invoking handle command',
"\$!: $!\n", "\$^E: $^E";
} #1 end unless ($sta)
while (<$command>) {
chomp;
$j = $_;
push @handle_output, $_;
PrintDebug $parms{Debug}, $parms{LogRef}, $_;
} # end while (<$command>)
close $command;
} # 1 end if (defined $file_line)
else { #1
say ': couldn\'t find match for {FileName}, $file_line not defined',
"\n", '@handle_output =', scalar @handle_output, ", \$pid= $pid";
confess '';
} # end else (! defined $file_line)
} # end sub force_close
サブルーチンYNCoiceおよびTerminateWindow：
sub YNChoice { # Ask a yes/no question, in a 2 radio boxes window
# call: $answer = YNChoice (Question => $Question, SizeRef => \@Size,
# PosRef => \@Pos, (in percentages), LogRef => \%Log, Debug => $Debug);
# Size and Pos (in percent of desktop) are optional
my %parms = @_;
my ($i, $j, $k, $desk, $w, $h, $WindowChoice, $wPCT, $hPCT, $deskw, $deskh, $x, $y, $xPCT, $yPCT);
my $wPCTmin =20; my $hPCTmin = 15;
my @UserChoice;
$desk = Win32::GUI::GetDesktopWindow();
$deskw = Win32::GUI::Width($desk);
$deskh = Win32::GUI::Height($desk);
$xPCT = (defined $parms{PosRef}[0] and $parms{PosRef}[0] >=0 and $parms{PosRef}[0] <=100) ?
($parms{PosRef}[0]) : 20;
$yPCT = (defined $parms{PosRef}[1] and $parms{PosRef}[1] >=0 and $parms{PosRef}[1] <=100) ?
($parms{PosRef}[1]) : 20;
$wPCT = (defined $parms{SizeRef}[0] and $parms{SizeRef}[0] >=0 and $parms{SizeRef}[0] <=100) ?
$parms{SizeRef}[0] : 20;
$wPCT = $wPCT >= $wPCTmin ? $wPCT : $wPCTmin;
$hPCT = (defined $parms{SizeRef}[1] and $parms{SizeRef}[1] >=0 and $parms{SizeRef}[1] <=100) ?
$parms{SizeRef}[1] : 12;
$hPCT = $hPCT >= $hPCTmin ? $hPCT : $hPCTmin;
$WindowChoice = Win32::GUI::Window->new( -name => 'choice', -text => $parms{Question},
-pos => [$xPCT/100*$deskw, $yPCT/100*$deskh],
-size => [$wPCT/100*$deskw,$hPCT/100*$deskh], -dialogui => 1,
-onTerminate => \&TerminateWindow, -tabstop => 1,
-addexstyle => WS_EX_TOPMOST, -cancel => 1, );
$WindowChoice -> AddRadioButton ( -name => 'ButtonRadioYes', -pos => [10,10],
-size => [20,20], -onClick => sub { &RadioClickYes(\@UserChoice) });
$WindowChoice -> AddLabel (-name => 'LabelRadioYes', -text=> 'Yes', -pos => [30,10],
-size => [40,20]);
$WindowChoice -> AddRadioButton ( -name => 'ButtonRadioNo', -pos => [10,40],
-size => [20,20], -onClick => sub { &RadioClickNo(\@UserChoice) });
$WindowChoice -> AddLabel (-name => 'LabelRadioNo', -text=> 'No', -pos => [30,40],
-size => [40,20]);
$WindowChoice ->Show();
Win32::GUI::Dialog();
TerminateWindow();
return $UserChoice[0];
} # end sub YNChoice
sub TerminateWindow {
return -1;
} # end sub TerminateWindow
サブルーチンRadioClickYesおよびRadioClickNo：
sub RadioClickYes {
$_[0][0] = 1;
TerminateWindow();
} # end sub RadioClickYes
sub RadioClickNo {
$_[0][0] = 0;
TerminateWindow();
} # end sub RadioClickNo