1

File::Find を使用して、1) 特定のフォルダーとサブフォルダーを調べて、30 日以上経過したファイルを削除し、b) すべての削除後に親フォルダーが空の場合は、それも削除します。

これが私のコードです：

use strict;
use warnings;
no warnings 'uninitialized';
use File::Find;
use File::Basename;
use File::Spec::Functions;

# excluding some home brew imports


# go into given folder, delete anything older than 30 days, and if folder is then empty,     delete it

my $testdir = 'C:/jason/temp/test';
$testdir =~ s#\\#/#g;

open(LOG, ">c:/jason/temp/delete.log");

finddepth({ wanted => \&myWanted, postprocess => \&cleanupDir }, $testdir);

sub myWanted {

   if ($_ !~ m/\.pdf$/i &&
       int(-M $_) > 30
      ) 
   {
      my $age = int(-M $_);
      my $path = $File::Find::name;
      print LOG "age : $age days - $path\n";
      unlink($path);

   }
}


sub cleanupDir {
   my $path = $File::Find::dir;
   if ( &folderIsEmpty($path) ) {
      print LOG "deleting : $path\n";
      unlink($path);
   } else {
      print LOG "$path not empty\n";
      my @files = glob("$path/*");
      foreach my $file(@files){
         print LOG "\t$file\n";
      }
   }

}

私は、finddepth() がツリーの最下部に移動し、上に向かって動作すると考えていましたが、そうはなりませんでした。一部の電子ブック コンテンツの解凍時に実行されるスクリプトは、すべてのファイルが削除されたにもかかわらず、サブフォルダーを含むディレクトリを削除しませんでした。

age : 54 days - C:/jason/temp/test/mimetype
age : 54 days - C:/jason/temp/test/META-INF/container.xml
age : 54 days - C:/jason/temp/test/META-INF/ncx.xml.kindle
deleting : C:/jason/temp/test/META-INF
age : 54 days - C:/jason/temp/test/OEBPS/content.opf
age : 54 days - C:/jason/temp/test/OEBPS/cover.html
age : 54 days - C:/jason/temp/test/OEBPS/ncx.xml
age : 54 days - C:/jason/temp/test/OEBPS/pagemap.xml
age : 54 days - C:/jason/temp/test/OEBPS/t01_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t02_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t03_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t04_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t05_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t06_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t07_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t08_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t08_01_text.html
age : 54 days - C:/jason/temp/test/OEBPS/media/cover.jpg
age : 54 days - C:/jason/temp/test/OEBPS/media/flamlogo.gif
age : 54 days - C:/jason/temp/test/OEBPS/media/logolnmb.jpg
age : 54 days - C:/jason/temp/test/OEBPS/media/stylesheet.css
deleting : C:/jason/temp/test/OEBPS/media
C:/jason/temp/test/OEBPS not empty
    C:/jason/temp/test/OEBPS/media
C:/jason/temp/test not empty
    C:/jason/temp/test/META-INF
    C:/jason/temp/test/OEBPS

C:/jason/temp/test/OEBPS/media/ が削除されたように見えますが、前処理関数が呼び出されるまでにその削除は登録されていませんでした。これを機能させる方法についてのアイデアはありますか? ありがとう！

ありがとう、bp

4

3 に答える 3

1

実際にはディレクトリを削除していないと思われます。のドキュメントからunlink:

注:スーパーユーザーであり、フラグが Perl に提供されてunlinkいない限り、 はディレクトリを削除しようとしません。-Uこれらの条件が満たされている場合でも、ディレクトリのリンクを解除するとファイルシステムに損害を与える可能性があることに注意してください。最後に、unlinkon ディレクトリの使用は、多くのオペレーティング システムでサポートされていません。rmdir代わりに使用してください。

于 2014-03-12T19:36:42.093 に答える
0

File::Findそれはただ混乱しているので、私は決して好きではありませんでした。すべてを必要なサブルーチンに入れたいため、プログラム全体を飲み込みます。さらに、コードの半分があちこちに散らばっているという事実も気に入りません。ただし、Perl のすべてのインストールに標準で付属しているツールは他にあります。私はやらなければなりません。

私はすべてのファイルを配列に放り込むことを好みます。コードをきれいに保ちます。私findが見つけたばかりです。残りの処理は別の場所で行います。また、必要なサブルーチンを find コマンドに埋め込みます。すべてを 1 か所に保持します。

unlinkまた、ディレクトリの削除には使用できません。File::Pathremove_treeから使用します。それが標準モジュールです。を使用して、ディレクトリに含まれるサブディレクトリの数を確認することもできます。これは、空かどうかを確認する良い方法です。readdir

use strict;
use warnings;
use feature qw(say);

use File::Find;
use File::Path qw(make_path remove_tree);

my $testdir     = 'C:/jason/temp/test';
my $mdate_limit = 30;

my @files;              # We'll store the files here
my %dirs;               # And we'll track the directories that my be empty

#
# First find the files
#
find ( sub {
    return unless -f;                  # We want just files.
    return if -M < $mdate_limit;       # Skip if we've modified since $mdate_limit days
    push @files, $File::Find::name;    # We're interested in this file,
    $dirs{$File::Find::dir} = 1;       # and the directory that file is in
}, $testdir );

#
# Delete the files that you've found
#

unlink @files;

#
# Go through the directories and see which are empty
#

for my $dir ( sort keys %dirs ) {
    opendir my $dir_fh, $dir or next;  # We'll skip bad reads
    my @dir_files = readdir $dir_fh;
    close $dir_fh;
    if ( @dir_files <= 2 ) {   # Directory is empty if there's only "." and ".." in it
        remove_tree( $dir )
          or warn qq(Can't remove directory "$dir"\n);
    }
}

wantedルーチンが埋め込まれていることに注意してください。

find ( sub {
    return unless -d;                  # We want just files.
    return if -M < $mdate_limit;       # File hast been modified in the $mdate_limit days
    push @files, $Find::File::name;    # We're interested in this file
    $dirs{$Find::File::dir} = 1;       # The directory that file is in
}, $testdir );

別の方法は次のとおりです。

file (\&wanted, $testdir);

sub wanted {
    return unless -d;                  # Okay...
    return if -M < $mdate_limit;       # Um... Where's $mdate_limit defined?
    push @files, $Find::File::name;    # And @files?
    $dirs{$Find::File::dir} = 1;       # And %dirs?
}

問題は、wantedサブルーチンに 3 つのグローバル変数が含まれていることです。また、コマンドがサブルーチンfindから分離される可能性があります。3 か月後には、そのルーチンwantedを見つけるためにコード全体を検索する必要があります。wanted

そして、そのサブルーチンを見るとwanted、これらの 3 つの謎のグローバル変数があります。それらはどこで定義されていますか？それはバグですか？

サブルーチンを my find と組み合わせることで、findコマンドが必要とするサブルーチンが my から離れないことを保証しfindます。さらに、サブルーチンに埋め込まれた 3 つの変数のグローバル性が隠されています。

find コマンド内のファイルを削除することを妨げるものは何もありません。通常、検索中にディレクトリ構造を変更することはお勧めできませんが、これで問題ありません。

ただし、興味のあるファイルを見つけるfindだけのコマンドが好きです。プログラムの半分をそこに詰め込みたくありません。メンテナンスの悪夢になります。多少の非効率は我慢します。100 万のファイルを配列にロードするのに 1 秒か 2 秒かかるかもしれませんが、プログラムのデバッグが必要になるとすぐに、それ以上の時間がかかります。@files

于 2014-03-12T22:30:13.807 に答える