とあるディレクトリにある重複ファイルを消す。

Perl

個人的につくったシステムでDBのバックアップを定期的にあるディレクトリに吐いているのだが、そんなに頻繁にデータが更新されるわけではないので、まったく同じ(Identical)ファイルがバックアップフォルダに並ぶことになるのだ。

なんとなくディスクが無駄である。
そこで、同階層にある重複ファイルは削除するプログラムをPerlで作った。

にMD5はコストがかかるのだ、とある。が、それを改良した

のFile::Find::IdenticalというモジュールもCPANにあがってそうでないので、MD5で比較することにしました。別にコストといっても気になるレベルじゃないしー。

#!/usr/bin/perl

use strict;
use warnings;
use Digest::MD5;

my $dir = $ARGV[0] || die "$0 dir";

opendir my $dh, $dir or die "Cannot opendir: $dir";
my %hash = ();

for my $f ( sort grep !/^\./, readdir($dh) ) {
    my $filepath = "$dir/$f";

    next unless -f $filepath;

    open my $fh, "<", $filepath or die;
    my $md5 = Digest::MD5->new->addfile($fh)->hexdigest;
    close $fh or die;

    if (exists $hash{$md5}) {
        unlink $filepath;
        print "unlink $filepath";
    } else {
        $hash{$md5} = $filepath;
        print "not unlink $filepath";
    }
    print "\n";
}

closedir $dh;

exit;

とりあえず動いています。Md5のコリジョンとか発生しても責任とりませんでｗ。