bzr commit into mysql-5.1 branch (msvensson:2692)

[Magnus Svensson]

#At file:///home/msvensson/mysql/5.1-rpl-work/

 2692 Magnus Svensson	2008-10-06
      WL4189 Add Handles.pm and use it from My::File::Path to show open handles. Rewrite rmtree to use File::Find so we can get better debug printouts when something fails
added:
  mysql-test/lib/My/Handles.pm
modified:
  mysql-test/lib/My/File/Path.pm

=== modified file 'mysql-test/lib/My/File/Path.pm'
--- a/mysql-test/lib/My/File/Path.pm	2007-12-12 17:19:24 +0000
+++ b/mysql-test/lib/My/File/Path.pm	2008-10-06 17:51:33 +0000
@@ -20,33 +20,40 @@ use Exporter;
 use base "Exporter";
 our @EXPORT= qw / rmtree mkpath copytree /;
 
-
 use File::Find;
-use File::Path;
 use File::Copy;
 use Carp;
-
-no warnings 'redefine';
+use My::Handles;
 
 sub rmtree {
   my ($dir)= @_;
-
-  #
-  # chmod all files to 0777 before calling rmtree
-  #
   find( {
-	 no_chdir => 1,
+	 bydepth 		=> 1,
+	 no_chdir 		=> 1,
 	 wanted => sub {
-	   chmod(0777, $_)
-	     or warn("couldn't chmod(0777, $_): $!");
-	 }
-	},
-	$dir
-      );
+	   my $name= $_;
+	   if (!-l $name && -d _){
+	     return if (rmdir($name) == 1);
+
+	     chmod(0777, $name) or carp("couldn't chmod(0777, $name): $!");
 
+	     return if (rmdir($name) == 1);
 
-  # Call rmtree from File::Path
-  goto &File::Path::rmtree;
+	     # Failed to remove the directory, analyze
+	     carp("Couldn't remove directory '$name': $!");
+	     My::Handles::show_handles($name);
+	   } else {
+	     return if (unlink($name) == 1);
+
+	     chmod(0777, $name) or carp("couldn't chmod(0777, $name): $!");
+
+	     return if (unlink($name) == 1);
+
+	     carp("Couldn't delete file '$name': $!");
+	     My::Handles::show_handles($name);
+	   }
+	 }
+	}, $dir );
 };
 
 

=== added file 'mysql-test/lib/My/Handles.pm'
--- a/mysql-test/lib/My/Handles.pm	1970-01-01 00:00:00 +0000
+++ b/mysql-test/lib/My/Handles.pm	2008-10-06 17:51:33 +0000
@@ -0,0 +1,69 @@
+# -*- cperl -*-
+# Copyright (C) 2008 MySQL AB
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+
+package My::Handles;
+
+
+use strict;
+use Carp;
+
+use My::Platform;
+
+my $handle_exe;
+
+
+if (IS_WINDOWS){
+  # Check if handle.exe is available
+  # Pass switch to accept the EULA to avoid hanging
+  # if the program hasn't been run before.
+  my $list= `handle.exe -? -accepteula 2>&1`;
+  foreach my $line (split('\n', $list))
+  {
+    $handle_exe= "$1.$2"
+      if ($line =~ /Handle v([0-9]*)\.([0-9]*)/);
+  }
+  if ($handle_exe){
+    print "Found handle.exe version $handle_exe\n";
+  }
+}
+
+
+sub show_handles
+{
+  my ($dir)= @_;
+  return unless $handle_exe;
+  return unless $dir;
+
+  $dir= native_path($dir);
+
+  # Get a list of open handles in a particular directory
+  my $list= `handle.exe "$dir" 2>&1` or return;
+
+  foreach my $line (split('\n', $list))
+  {
+    return if ($line =~ /No matching handles found/);
+  }
+
+  print "\n";
+  print "=" x 50, "\n";
+  print "Open handles in '$dir':\n";
+  print "$list\n";
+  print "=" x 50, "\n\n";
+
+  return;
+}
+
+1;