title: Perl cannot close files on Windows?
body: <p>I am encountering a very strange behavior.</p>
  
  <p>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.</p>
  
  <p>How do I know that the files do not get closed? Because when trying to Perl "move" function on them, it gives the errors:</p>
  
  <p>$!: Permission denied</p>
  
  <p>$^E: The process cannot access the file because it is being used by another process</p>
  
  <p>I have tested this program on two different computers, one running Windows XP SP 3, and the other Windows 7 - getting <em>identical</em> results.</p>
  
  <p>When I "clobber" the files using the Windows "handle.exe" utility, then the files do get closed, and I can "move" (rename) the files.</p>
  
  <p>(I am sorry that this question is lengthy, but otherwise responders may say that there isn't enough detail to understand the issues).</p>
  
  <p>Here are the code examples. </p>
  
  <p>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!)</p>
  
  <p>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.</p>
  
  <p>Explanatory notes:
  a. File information is held in simple hashes, containing the file handle and the mode, (in addition to the file name).</p>
  
  <p>b. Subroutine YNChoice is a simple radio button yes/no choice window.</p>
  
  <p>The main program:</p>
  
  <pre><code>use strict;
   use warnings;
   use 5.014; 
   use Win32::GUI();
   use Win32::Console;
   use autodie; 
   use warnings qw&lt; FATAL utf8 &gt;;
   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 =&gt; $TopDir, -includefiles =&gt; 1,
                      -title =&gt; 'Select directory for file to rename', -newui =&gt; 1, 
                      -text =&gt;'text Select directory for file', -size =&gt; [60/100*$dw, 60/100*$dh],
                      -position =&gt;  [50/100*$dw, 50/100*$dh], -owner =&gt;$desk);
  $log{FileName} = $InputDir.'\Close file test log '.DatenTime().'.txt';
  $i = OpenFile \%log, "&gt;: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  =&gt; 'Select file to open and close with handle',
          -directory =&gt; $InputDir, -file   =&gt; "\0" . " " x 256,
          -filter =&gt; ["All files", "*.*", "Text files (*.txt)" =&gt; "*.txt",],
          -text =&gt; 'Select file');
  $inp_file{FileName} = $filename;
  $inpH = OpenFile \%inp_file, "&lt;: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, '&gt;:encoding(utf8)', 
                  ": opening \$res_file for output:\n'$res_file{FileName}'";
  binmode $resH, ':unix:utf8';
  local $/ = "\x0D\x0A";
  while (&lt;$inpH&gt;) { #1
      chomp;
      $i = $_;
      s{^(.*)(?&lt;!\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 (&lt;$inpH&gt;)
  
  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-&gt;mode &amp; 07777;
  say ": for file \$inp_file{FileName}:\n'$inp_file{FileName}'\n",
      'Mode is: ', $fmode, ', $stobj-&gt;mode = ', $stobj-&gt;mode;
  $forceclose_choice = YNChoice Question =&gt; 'force_close $inp_file and $res_file?',
                                          Debug =&gt; $debug, SizeRef =&gt; [30,15], LogRef =&gt; \%log;
  if ($forceclose_choice) { #1
      $pid = $PID;
      force_close FileName =&gt; $inp_file{FileName}, owning_process =&gt; $pid, LogRef =&gt; \%log,
              Debug =&gt; $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 =&gt; $res_file{FileName}, owning_process =&gt; $pid, LogRef =&gt; \%log,
                  Debug =&gt; $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;
  </code></pre>
  
  <p>Subroutines OpenFile and CloseFile:</p>
  
  <pre><code>sub OpenFile {      # Call: OpenFile \%FileStruct, $Mode, $Message [,$Message ...];
      my ($FileRef, $Mode) =@_[0..1];
      my ($HANDLE, $FileName, $sta);
      $FileName = $FileRef-&gt;{FileName};
      if (@_ &gt;=3) { #1
          foreach (@_[2..(scalar @_-1)]) { #2
              print $_;
          }   #2 end foreach (@_[2..(scalar @_ -1)])
          print "\n";
      }   #1 end if (@_ &gt;=3)
      unless ( defined $FileName) { confess 'Utilities::OpenFile: $FileName undefined';}
      elsif ($Mode =~ m{.*&lt;.*}) { #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-&gt;{HANDLE} and defined openhandle($FileRef-&gt;{HANDLE}) 
                  and defined $FileRef-&gt;{Mode} and ($FileRef-&gt;{Mode} =~ m{^.*&lt;.*$})) { #1
          $sta = open ($HANDLE, $Mode, $FileName);
          if ($sta) { #2
              $FileRef-&gt;{HANDLE} = $HANDLE;
              $FileRef-&gt;{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-&gt;{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-&gt;{FileName};
      if (@_ &gt;=1) { #1  There is a message
          foreach (@_) { #2
              print $_;
          }   #2 end foreach (@_[1..(scalar @_ -1)])
          print "\n";
      }   #1 end if (@_ &gt;=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-&gt;{HANDLE})) { #1
          say ": file $FileName is closed!";
          $sta = 0;                                                   
      } else {  #1
          $sta = close $FileRef-&gt;{HANDLE};
          unless ( $sta) {  #2
              confess "Can't close \$HANDLE: file:\n'$FileName'\n\$!: $!\n\$^E: $^E";
          } else {  #2
              undef $FileRef-&gt;{Mode};
          }  #2 end else $sta
      } #1 end else defined handle
      return $sta;
  } # end sub CloseFile
  </code></pre>
  
  <p>Subroutine force_close:</p>
  
  <pre><code>sub force_close { # close $FileStruct{FileName} using MS handle -------------------- force_close
  # call: $sta = force_close FileName =&gt; $file_name, owning_process =&gt; $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 (&lt;$command&gt;) {
      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 (&lt;$command&gt;)
  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 (&lt;$command&gt;) {
          chomp;
          $j = $_;
          push @handle_output, $_;
          PrintDebug $parms{Debug}, $parms{LogRef}, $_;
      } # end while (&lt;$command&gt;)
      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
  </code></pre>
  
  <p>subroutines YNCoice and TerminateWindow:</p>
  
  <pre><code>sub YNChoice { # Ask a yes/no question, in a 2 radio boxes window  
          # call: $answer = YNChoice (Question =&gt; $Question, SizeRef =&gt; \@Size,
          #       PosRef =&gt; \@Pos, (in percentages), LogRef =&gt; \%Log, Debug =&gt; $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] &gt;=0 and $parms{PosRef}[0] &lt;=100) ?
                  ($parms{PosRef}[0]) : 20;
  $yPCT = (defined $parms{PosRef}[1] and $parms{PosRef}[1] &gt;=0 and $parms{PosRef}[1] &lt;=100) ?
                  ($parms{PosRef}[1]) : 20;
  $wPCT = (defined $parms{SizeRef}[0] and $parms{SizeRef}[0] &gt;=0 and $parms{SizeRef}[0] &lt;=100) ?
                  $parms{SizeRef}[0] : 20;
  $wPCT = $wPCT &gt;= $wPCTmin ? $wPCT : $wPCTmin;
  $hPCT = (defined $parms{SizeRef}[1] and $parms{SizeRef}[1] &gt;=0 and $parms{SizeRef}[1] &lt;=100) ?
                  $parms{SizeRef}[1] : 12;
  $hPCT = $hPCT &gt;= $hPCTmin ? $hPCT : $hPCTmin;
  $WindowChoice = Win32::GUI::Window-&gt;new( -name =&gt; 'choice', -text =&gt; $parms{Question},
          -pos =&gt; [$xPCT/100*$deskw, $yPCT/100*$deskh], 
          -size =&gt; [$wPCT/100*$deskw,$hPCT/100*$deskh], -dialogui =&gt; 1,
          -onTerminate =&gt; \&amp;TerminateWindow, -tabstop =&gt; 1,
          -addexstyle =&gt; WS_EX_TOPMOST, -cancel =&gt; 1, );
  $WindowChoice -&gt; AddRadioButton ( -name =&gt; 'ButtonRadioYes', -pos =&gt; [10,10],
                          -size =&gt; [20,20], -onClick =&gt; sub { &amp;RadioClickYes(\@UserChoice) });
  $WindowChoice -&gt; AddLabel (-name =&gt; 'LabelRadioYes', -text=&gt; 'Yes', -pos =&gt; [30,10],
                          -size =&gt; [40,20]);
  $WindowChoice -&gt; AddRadioButton ( -name =&gt; 'ButtonRadioNo', -pos =&gt; [10,40],
                          -size =&gt; [20,20], -onClick =&gt; sub { &amp;RadioClickNo(\@UserChoice) });
  $WindowChoice -&gt; AddLabel (-name =&gt; 'LabelRadioNo', -text=&gt; 'No', -pos =&gt; [30,40],
                          -size =&gt; [40,20]);
  $WindowChoice -&gt;Show();
  Win32::GUI::Dialog();
  TerminateWindow();
  return $UserChoice[0];
  } # end sub YNChoice
  
  sub TerminateWindow {
      return -1;
  } # end sub TerminateWindow
  </code></pre>
  
  <p>Subroutines RadioClickYes and RadioClickNo:</p>
  
  <pre><code>sub RadioClickYes {
      $_[0][0] = 1;
      TerminateWindow();
  } # end sub RadioClickYes
  
  sub RadioClickNo {
      $_[0][0] = 0;
      TerminateWindow();
  } # end sub RadioClickNo
  </code></pre>