I am encountering a very strange behavior.
My Perl program is trying to close some files on Windows. It turns out that the files do not close - and there is no error message.
How do I know that the files do not get closed? Because when trying to Perl "move" function on them, it gives the errors:
$!: Permission denied
$^E: The process cannot access the file because it is being used by another process
I have tested this program on two different computers, one running Windows XP SP 3, and the other Windows 7 - getting identical results.
When I "clobber" the files using the Windows "handle.exe" utility, then the files do get closed, and I can "move" (rename) the files.
(I am sorry that this question is lengthy, but otherwise responders may say that there isn't enough detail to understand the issues).
Here are the code examples.
In this program, if the user chooses "yes" "force_close", the sub force_close is called, and the files do get closed. If the user chooses "no", then it's only the Perl program calling the "close" function on these two *.csv files, and actually they stay open! ("close" returns with no errors!)
Important note: no other process is using the files, or holding them open. (Neither a possible "anti virus"). How do I know? Because the "force_close" subroutine does succeed in closing the files, using a single Windows handle connected to the perl.exe process; if another process kept the files open, then there should have been an additional open handle for that file, and Perl "move" function would fail.
Explanatory notes: a. File information is held in simple hashes, containing the file handle and the mode, (in addition to the file name).
b. Subroutine YNChoice is a simple radio button yes/no choice window.
The main program:
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;
Subroutines OpenFile and 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
Subroutine 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
subroutines YNCoice and 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
Subroutines RadioClickYes and RadioClickNo:
sub RadioClickYes {
$_[0][0] = 1;
TerminateWindow();
} # end sub RadioClickYes
sub RadioClickNo {
$_[0][0] = 0;
TerminateWindow();
} # end sub RadioClickNo
