Why can't I delete this empty directory in Perl?
I am converting linux script from http://www.perlmonks.org/index.pl?node_id=217166 exactly this:
#!/usr/bin/perl -w
use strict;
use Getopt::Std;
use File::Find;
@ARGV > 0 and getopts('a:', \my %opt) or die << "USAGE";
# Deletes any old files from the directory tree(s) given and
# removes empty directories en passant.
usage: $0 [-a maxage] directory [directory ...]
-a maximum age in days, default is 120
USAGE
my $max_age_days = $opt{a} || 120;
find({
wanted => sub { unlink if -f $_ and -M _ > $max_age_days },
postprocess => sub { rmdir $File::Find::dir },
}, @ARGV);
my attempt:
#!/usr/bin/perl -w
use strict;
use Getopt::Std;
use File::Find;
@ARGV > 0 and getopts('a:', \my %opt) or die << "USAGE";
# Deletes any old files from the directory tree(s) given and
# removes empty directories en passant.
usage: $0 [-a maxage] directory [directory ...]
-a maximum age in days, default is 120
USAGE
my $max_age_days = $opt{a} || 120;
find({
wanted => sub { unlink if -f $_ and -M _ > $max_age_days },
# postprocess => sub { rmdir $File::Find::dir },
postprocess => sub {
my $expr = "$File::Find::dir";
$expr =~ s/\//\\/g; # replace / with \
print "rmdir $expr\n";
`rmdir $expr`;
},
}, @ARGV);
However, I get an error when a script tries to delete a directory saying the directory is in use by another process (when it is not). Any ideas? I am running the script on Windows Server 2003 64-bit with Service Pack 2 (SP2) using ActiveState 5.10.
Thank!
source to share
From documentation
post-processing
The value must be a code reference. It is called just before leaving the currently processed directory . It is called in void context with no arguments. The name of the current directory is in $ File :: Find :: dir. This hook is useful for generalizing a directory, for example calculating its disk usage. when follow or follow_fast is in effect, postprocess is a non-op.
This means that your own code is still using the directory when you try to delete it. Try to create a list of names and repeat after calling to find.
Another possible solution is to use an option no_chdir
to avoid finding the directories you want to delete.
EDIT: This comment is relevant too, so I'm moving it into the main body of the answer:
To add to this: The problem here is that on Linux it is possible to delete files and directories that are in use, on Windows it fails. This is why it doesn't work unchanged. - Leon Timmermans
source to share
Thanks for all your answers. My final script looks like this:
#!/usr/bin/perl -w
use strict;
use warnings;
use Getopt::Std;
use File::Find;
use Win32::OLE;
@ARGV > 0 and getopts('a:', \my %opt) or die << "USAGE";
Deletes any old files from the directory tree(s) given and
removes empty directories en passant.
usage: $0 [-a maxage] directory [directory ...]
-a maximum age in days, default is 30
USAGE
my $max_age_days = $opt{a} || 30;
my @dir_list = undef;
find({
wanted => sub { if (-f $_ and -M _ > $max_age_days) {
unlink $_ or LogError ("$0: Could not delete $_ ($!)")}},
postprocess => sub {push(@dir_list,$File::Find::dir)},
}, @ARGV);
if (@dir_list) {foreach my $thisdir (@dir_list) { rmdir $thisdir if defined ($thisdir)}}
############
sub LogError {
my ($strDescr) = @_;
use constant EVENT_SUCCESS => 0;
use constant EVENT_ERROR => 1;
use constant EVENT_WARNING => 3;
use constant EVENT_INFO => 4;
my $objWSHShell = Win32::OLE->new('WScript.Shell');
$objWSHShell->LogEvent(EVENT_ERROR, $strDescr);
}
Everything seems to work fine - can you think of any way to improve it?
source to share