複数のディレクトリ下にあるファイルすべての MD5 ハッシュをとって,一致してるファイルを表示する perl script
極めて久々.
先日,別の拠点にあるファイルサーバーのデータを持ってきてこちらのファイルサーバーにコピーしようとしたのだけども,どうも中身が同じファイルが多いようなので,ファイルの MD5 ハッシュとって同じだったら同一内容のファイルだとして消そうと思った次第.
スクリプトの内容は下記ですが,このファイルを
$ ./filecomp.pl /hoge /booboo
みたいに実行すると,/hoge も /booboo にもある(そのサブディレクトリも含む)ファイルも全部ごっちゃにして MD5 ハッシュ計算して一致したファイル名をフルパスで表示します.
例えば /hoge/ahhan.txt と /hoge/uhhun.txt, /booboo/ahhan.txt が一致してると,順番はどうなるかわかりませんが,
/hoge/ahhan.txt(タブ区切り)/hoge/uhhun.txt
(タブ二個)/booboo/ahhan.txt
みたいな感じで二個以上ダブってたら三個目以上は二個タブの後ろにどんどんリストアップされる格好.
コードは以下.
#!/usr/bin/perluse strict;
use warnings;use File::Util;
use Digest::MD5;my $file_obj = File::Util->new(max_dives => 50000);
my @total_filelist;
my %key_filename;
my %key_hashed;
my $flag_overtwo;foreach (@ARGV) {
my @temp_filelist = $file_obj->list_dir($_,'--files-only','--recurse');
push @total_filelist, @temp_filelist;
}foreach (@total_filelist) {
open(TARGET, $_) || die "Can't open file, name: $_ :$!";
binmode(TARGET);
$key_filename{$_} = Digest::MD5->new->addfile(*TARGET)->hexdigest;
close(TARGET);
}foreach (sort{$key_filename{$b} cmp $key_filename{$a}} keys %key_filename) {
if($key_hashed{$key_filename{$_}}) {
if(! defined($flag_overtwo)) {
print "$key_hashed{$key_filename{$_}} \t $_\n";
$flag_overtwo = "deja été";
}
else {
print "\t\t $_\n";
}
}else {
undef($flag_overtwo);
}
$key_hashed{$key_filename{$_}} = $_;
}
コード内で File::Util のオブジェクト作るときの max_dives ってのは最大で何個のファイル(ディレクトリも含む?)を“掘る”かっていう感じの数字でデフォルトがかなり小さくて小生の目的では全然ダメなので大きくしてます.cpan 見てデフォルトで行くなり増やすなり適宜よろしくお願いします.
最初のループでは,引数で指定されたディレクトリ以下のファイルをぶりぶり調べてフルパスで配列 total_filelist にぶち込む.次のループでは total_filelist にある全ファイルの MD5 ハッシュを計算して,ファイル名をキー,ハッシュ値を値とするハッシュ:key_filename にぶち込む,最後のループでは %key_file ハッシュを値(すなわち MD5 ハッシュ値)でソートして,MD5 ハッシュ値をキー,フルパスのファイル名を値とするハッシュ:key_hashed を作る(すなわち reverse(%hash) をいちいちやる)ループなのですが,MD5 ハッシュ値であるキーがダブルと上書きされていくので,すでにそのキーがあると標準出力に書きだすし,一回そのキーで書き出すとフラグ:flag_overtwo がたってそれ以降の同じ MD5 ハッシュ値のダブりの処理ではタブ二個と最新の値(ファイルフルパス名)が標準出力に出てくるという話.
壮大な大車輪の大再発明のような気もしますが,その場合こっそり指摘していただければ幸い.
現在はディレクトリ自体一緒だと判断するのに,このスクリプトで出てきたディレクトリを
$ cd /ahhan
$ find . -type f > ahhan
$ cd /uhhun
$ find . -type f > uhhun
$ wc -l ahhan uhhun
あるいは
$ diff ahhan uhhun
みたいな感じで確認してディレクトリごと片方を削除したりしてます.それさえもスクリプトに含めるのは一瞬考えましたが,ファイラーもどきを書いてしまうのは too much でもあり,僭越でもあり,汎用性を考えて上のままで使ってます.
経済的メモリーの使い方とかマシンパワーとかは考慮していませんので,適宜改善の上色々していただければ幸いです.
BSD マシン上では動いてますけど,active perl 上ではどうなのでしょう?
はるか前にもエントリーあげましたが,MD5 ハッシュを cpan のモジュールで云々するというのはゆーすけべーさんのエントリー“いかにして効率よく大量のおっぱい画像をダウンロードするか”のコードの最後のほうに触発されたということが大きいです(最近は改良版とか ruby 版とか出ているといううわさですが)
Recent Comments