Why can't I remove this empty directory in Perl?

Question

Hi there,

I am converting a linux script from http://www.perlmonks.org/index.pl?node_id=217166 specifically 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 is:

#!/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 the script tries to remove a directory saying that the directory is in use by another process (when it isn't). Any ideas? I'm running the script on Windows Server 2003 SP2 64-bit using ActiveState 5.10.

Thanks!

Answer 1

Just a few notes:

1. You don't need to flip the / to an \. Perl understands that / is a directory separator, even on Windows.
2. rmdir is a Perl built-in, you don't need to call it with backticks.

Answer 2

From this documentation

postprocess

The value should be a code reference. It is invoked 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 handy for summarizing a directory, such as calculating its disk usage. When follow or follow_fast are in effect, postprocess is a no-op.

This means that your own code is still using the directory as you try to delete it. Try building a list of names and iterating through that after the call to find.

Another possible solution is to use the no_chdir option to avoid having find use the directories you want to delete.

EDIT: This comment is also relevant, so i'm promoting it to the main answer's body:

To add to that: the issue here is that on Linux one can delete files and directories that are in use, on windows one can't. That's why it doesn't work unmodified. - Leon Timmermans

Answer 3

The perlmonks version uses a Perl method "rmdir" to do the removal. Your version spawns a subshell with backquotes. So it's quite possible that the message is correct - the directory is still in use by Perl when the rmdir is trying to use it.

Answer 4

Thanks for all your replies. 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);
}

Seems to work great - can you think of any way to improve it?