指定の日数以上更新がないディレクトリを消す方法

Amazon Search は全ての検索結果をディスク上にキャッシュする仕組みになっているのですが、最近、キャッシュ容量が 20 GByte 程になり、ディスクを圧迫してきたので、60日以上更新がないアソシエイトID 配下の Amazon Search のキャッシュファイルを削除する事にしました。

※すいません・・・誤って必要なディレクトリまでかなり削除してしまったので、検索 query が多すぎてサーバが高負荷になってしまいました。バックアップからキャッシュを戻して再構築しています・・・orz

プログラム的は比較的簡単で、File::Find クラスを使うのがポイントです。汎用性が高いので、プログラムを公開します。Perl 5.6 以上で動作します。

use strict;
use File::Find;
use 5.6.0;

our $cache_dir    = './';   ## 探索したいルートディレクトリを記述
our $expire       = 60;     ## 記述した日数以上のディレクトリを削除
our @dirs;

find(\&wanted, $cache_dir);
my @sort_dirs = sort { $a->{Mrange} <=> $b->{Mrange} } @dirs;

print "status    modified    created    dir    name\n";
map{
    my $i = $_;
    if( $i->{Mrange} < $expire ) {
        print "[ok]    $i->{Mrange}    $i->{dir}    $i->{name}\n";
    } else {
        system(qq{rm -rf "$_->{name}"});
        print "[rm]    $i->{Mrange}    $i->{dir}    $i->{name}\n";
    }
} @sort_dirs;

sub wanted {
    ## 対象がディレクトリ
    if( -d $_ ) {
        my $hash = {
            Mrange    => int(-M $_),
            Arange    => int(-A $_),
            Crange    => int(-C $_),
            dir       => $File::Find::dir,
            name      => $File::Find::name,
        };
        push @dirs, $hash;
    }
}