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

このドキュメントから

後処理

値はコード参照である必要があります。現在処理中のディレクトリを離れる直前に呼び出されます。引数なしで無効なコンテキストで呼び出されます。現在のディレクトリの名前は $File::Find::dir にあります。このフックは、ディスク使用量の計算など、ディレクトリを要約するのに便利です。follow または follow_fast が有効な場合、postprocess はノーオペレーションです。

これは、ディレクトリを削除しようとしても、自分のコードがまだそのディレクトリを使用していることを意味します。名前のリストを作成し、find の呼び出し後にそれを繰り返してみてください。

もう 1 つの考えられる解決策は、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」を使用して削除を行います。あなたのバージョンは、逆引用符でサブシェルを生成します。したがって、メッセージが正しい可能性は十分にあります - 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 に答える