为什么我不能在Perl中删除这个空目录？

问题描述：

我从http://www.perlmonks.org/index.pl?node_id=217166转换的Linux脚本明确这一点：为什么我不能在Perl中删除这个空目录？

#!/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);

我的尝试是：

#!/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);

但是我得到当脚本试图删除目录说，目录是一个错误由另一个进程使用（当不是时）。有任何想法吗？我正在使用ActiveState 5.10在Windows Server 2003 SP2 64位上运行脚本。

谢谢！

答

从这documentation

后处理

值应该是一个代码引用。 它在之前被调用，离开当前处理的目录。它被称为void 上下文中没有参数。的当前目录的名称是 $ File :: Find :: dir。这个钩子是便利的用于汇总目录，例如计算其磁盘使用情况的。当 follow或follow_fast生效时，后处理是无效的。

这意味着当您尝试删除它时，您自己的代码仍在使用该目录。尝试构建一个名称列表，并在调用查找后遍历它。

另一种可能的解决方案是使用no_chdir选项来避免找到要使用的目录。

编辑：这一评论也有关，所以我也促进主要答复的身体：

要补充的：这里的问题是，在Linux上一个可以删除的文件和目录在使用中，在Windows上不能。这就是为什么它没有修改就无法正常工作。 - Leon Timmermans

要补充的是：这里的问题是，在Linux上可以删除文件和在Windows中不能使用的目录。这就是为什么它没有修改就无法正常工作。 – 2008-12-08 17:07:57

答

就在几个注意事项：

你不需要翻转/到一个\。 Perl知道/是一个目录分隔符，即使在Windows上也是如此。
rmdir是一个内置的Perl，你不需要用反引号来调用它。

实际上，Windows可以理解/是一个目录分隔符。您可以使用/从任何编程语言，并且通常可以从命令行使用，只要您将路径用引号引起来：cd“go/to/dir” – 2008-12-10 20:42:28

答

perlmonks版本使用Perl方法“rmdir”来执行删除操作。你的版本产生一个带有反引号的子shell。所以消息很可能是正确的 - 当rmdir尝试使用它时，该目录仍然被Perl使用。

答

感谢您的回复。我的最终脚本如下所示：

#!/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); 
}

似乎很好用 - 你能想出任何改善它的方法吗？

为什么我不能在Perl中删除这个空目录？

相关推荐