我遇到了一个非常奇怪的行为。
我的 Perl 程序试图关闭 Windows 上的一些文件。事实证明，文件没有关闭 - 并且没有错误消息。
我怎么知道文件没有被关闭？因为当尝试对它们执行 Perl“移动”功能时，它会给出错误：
$!: 权限被拒绝
$^E：该进程无法访问该文件，因为它正被另一个进程使用
我已经在两台不同的计算机上测试了这个程序，一台运行 Windows XP SP 3，另一台运行 Windows 7 - 得到相同的结果。
当我使用 Windows“handle.exe”实用程序“破坏”文件时，文件确实会关闭，我可以“移动”（重命名）文件。
（我很抱歉这个问题很长，但否则响应者可能会说没有足够的细节来理解这些问题）。
以下是代码示例。
在这个程序中，如果用户选择“yes”“force_close”，子 force_close 被调用，文件被关闭。如果用户选择“否”，那么只有 Perl 程序在这两个 *.csv 文件上调用了“关闭”函数，实际上它们保持打开状态！（“关闭”返回没有错误！）
重要提示：没有其他进程正在使用这些文件，或者将它们保持打开状态。（都不是可能的“反病毒”）。我怎么知道？因为“force_close”子例程确实成功地关闭了文件，使用连接到 perl.exe 进程的单个 Windows 句柄；如果另一个进程保持文件打开，那么该文件应该有一个额外的打开句柄，Perl“移动”函数将失败。
解释性说明：文件信息保存在简单的散列中，包含文件句柄和模式（除了文件名）。
湾。子程序 YNchoice 是一个简单的单选按钮是/否选择窗口。
主程序：
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