Question

我正在从http://www.perlmonks.org/index.pl?node_id=217166转换linux脚本，特别是：

#!/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位上运行该脚本。

谢谢！

Answer 1

从此documentation

后处理

该值应为代码引用。 之前调用它   离开当前处理过的   目录的。它被称为无效   没有参数的上下文。的名字   当前目录在   $文件::查找::迪尔。这个钩子很方便   用于汇总目录，例如   计算其磁盘使用情况。什么时候   follow或follow_fast生效，   后处理是一种无操作。

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

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

编辑：这条评论也很相关，所以我将它推广到主要答案的正文：

除此之外：这里的问题是在Linux上可以删除正在使用的文件和目录，而在Windows上则不能。这就是为什么它没有修改不起作用的原因。 - Leon Timmermans

Answer 2

只是几点说明：

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

Answer 3

perlmonks版本使用Perl方法“rmdir”进行删除。您的版本会生成带反引号的子shell。所以消息很可能是正确的 - 当rmdir尝试使用它时，Perl仍在使用该目录。

Answer 4

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

#!/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中的这个空目录？

4 个答案: