4

我正在从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 位上运行该脚本。

谢谢！

4

4 回答 4

16

从这个文档

后期过程

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

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

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

编辑：此评论也很相关，因此我将其推广到主要答案的正文：

补充一点：这里的问题是，在 Linux 上可以删除正在使用的文件和目录，而在 Windows 上则不能。这就是为什么它在未经修改的情况下无法工作。-莱昂蒂默曼斯

于 2008-12-08T16:09:04.727 回答
9

只是一些注意事项：

  1. 您无需将 / 翻转为 \。Perl 理解 / 是目录分隔符，即使在 Windows 上也是如此。
  2. rmdir 是 Perl 内置的，你不需要用反引号调用它。
于 2008-12-08T16:07:35.367 回答
4

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

于 2008-12-08T16:10:59.933 回答
1

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

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

似乎工作得很好 - 你能想出任何改进它的方法吗？

于 2008-12-11T15:48:38.867 回答