Commit ab5c044e authored by Magnus Svensson's avatar Magnus Svensson

WL4189 Add Handles.pm and use it from My::File::Path to show open handles....

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
parent 22a89389
...@@ -20,33 +20,40 @@ use Exporter; ...@@ -20,33 +20,40 @@ use Exporter;
use base "Exporter"; use base "Exporter";
our @EXPORT= qw / rmtree mkpath copytree /; our @EXPORT= qw / rmtree mkpath copytree /;
use File::Find; use File::Find;
use File::Path;
use File::Copy; use File::Copy;
use Carp; use Carp;
use My::Handles;
no warnings 'redefine';
sub rmtree { sub rmtree {
my ($dir)= @_; my ($dir)= @_;
#
# chmod all files to 0777 before calling rmtree
#
find( { find( {
bydepth => 1,
no_chdir => 1, no_chdir => 1,
wanted => sub { wanted => sub {
chmod(0777, $_) my $name= $_;
or warn("couldn't chmod(0777, $_): $!"); if (!-l $name && -d _){
} return if (rmdir($name) == 1);
},
$dir chmod(0777, $name) or carp("couldn't chmod(0777, $name): $!");
);
return if (rmdir($name) == 1);
# Call rmtree from File::Path # Failed to remove the directory, analyze
goto &File::Path::rmtree; 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 );
}; };
......
# -*- 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;
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment