Perl無法關閉Windows上的文件？

Question

我遇到了一個非常奇怪的行爲。

我的Perl程序正試圖關閉Windows上的一些文件。事實證明，這些文件不會關閉 - 並且沒有錯誤信息。

我如何知道文件沒有關閉？因爲試圖對他們的Perl的「移動」功能時，它給人的錯誤：

$ !:權限被拒絕

$^E：，因爲它正在使用由另一個進程的進程無法訪問該文件

我已經在兩個不同的計算機上測試了這個程序，一個運行Windows XP SP 3，和其他Windows 7 - 入門相同結果。

當我「揍」使用Windows「handle.exe」實用工具中的文件，然後將這些文件確實會關閉，我可以「移動」（重命名）的文件。

（我很抱歉，這個問題是漫長的，但在其他方面反應可能會說，沒有足夠的細節來理解的問題）。

以下是代碼示例。

在這個程序中，如果用戶選擇「是」，「force_close」，子force_close被調用，文件確實會關閉。如果用戶選擇「否」，那麼只有Perl程序調用這兩個* .csv文件的「關閉」功能，並且實際上它們保持打開狀態！ （「關閉」返回，沒有錯誤！）

重要提示：沒有其他進程正在使用的文件，或拿着他們開放。 （既不是可能的「反病毒」）。我怎麼知道？由於「force_close」子例程在關閉文件方面確實成功，因此使用連接到perl.exe進程的單個Windows句柄;如果另一個進程保持文件打開，那麼應該有一個額外的文件打開句柄，Perl「移動」功能將失敗。

解釋性說明： 一個。文件信息保存在簡單的哈希中，包含文件句柄和模式（除文件名外）。

b。子程序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 

Answer 1

每次打電話的OpenFile併成功打開該文件，將創建2個文件句柄，但你只關閉其中之一。

下面是的OpenFile的代碼的關鍵個別線路。

這裏是第一文件句柄：

$ STA =開放（$ HANDLE，$模式，$文件名）;

在這裏你DUP它：

$ FileRef - > {} HANDLE = $手柄;

在這裏，我們回到第一個：

回報（$ STA $處理：$ STA）;

這裏的子

$ I =的OpenFile \％日誌的呼喚， 「>：編碼（UTF8）」，....

所以，現在你有一個處理$ i，第二個處於$ log {HANDLE}