perl - File::Find::Identical

それってPerlで。

ファイル名が違っても中身が同じファイルを探してくれる『NoClone』 | P O P * P O P

そこで便利そうなのがこのNoCloneです。重複したファイルを探してくれるツールです。そしてこれが便利なのは、きちんと中身をみて判断してくれる点。

すでにその名もずばりのFile::Find::Duplicatesというのも存在しているのですが、速度的にも問題があるし、APIも気に食わないので、File::Find::Identicalというものをこさえてみました。

例えば、重複ファイルをハードリンクに全て置き換えるには、これでOKです。

dupe2link

#!/usr/local/bin/perl
use strict;
use warnings;
use File::Find::Identical;
die "$0 path ..." unless @ARGV;
my $ffi = File::Find::Identical->new(sub {
  unlink $_[0]
  and link $_[1], $_[0]
  and printf "%s\t==\t%s\n", @_;
});
$ffi->find(@ARGV);

% dupe2link directory ...

見ての通り、new()の引数はコールバック関数で、1番目が見つかった重複ファイルのパス名、2番目が最初にチェックした重複ファイル名になります。

FreeBSD 6-Stableの/usr/ports/usr/srcのコピーを取ってこれを実行したところ、こんな感じになりました。

% du -s /usr/src ./src
521584  /usr/src
496220  ./src

CPANに上げるかどうかは、反響を見て決めることにします。

Enjoy!

Dan the Perl Monger

package File::Find::Identical;
use 5.008001;
use strict;
use warnings;
our $VERSION = sprintf "%d.%02d", q$Revision: 0.1 $ =~ /(\d+)/g;

use File::Find ();
use File::Compare;
use Cwd qw/abs_path/;

sub new{
    my $pkg = shift;
    my $callback = shift || sub { printf "%s\t==\t%s\n", @_ };
    bless $callback, $pkg;
}

sub find {
    my $self = shift;
    my %size;
    my %devino;
    File::Find::find(
        sub {
            my @stat = lstat($_);

            # no hard links
            my $devino = join( $;, @stat[ 0, 1 ] );
            return if $devino{$devino};
            $devino{$devino} = $File::Find::name;

            -l _ and return;    # no symlinks
            -f _ or return;     # files only

            my $s = -s _;
            if ( $size{$s} ) {
                for my $f ( @{ $size{$s} } ) {
                    unless ( compare $f, $File::Find::name ) {
                        $self->( $File::Find::name, $f );
                        return;
                    }
                }
                push @{ $size{$s} }, $File::Find::name;
            }
            else {
                $size{$s} = [$File::Find::name];
            }
          },
        map { abs_path $_ } @_
    );
}

1;

Comments

dupe2symlink という名前なのに、ハードリンクを作るコマンドはちょっと……。dupe2hardlink あるいは dupe2link くらいがいいのでは。

Posted by 6 at 2007年03月27日 01:16

6さん、
s/symlink/link/g;#しました。thanks!
Dan the (sym)?linker

Posted by 弾 at 2007年03月27日 01:26

多くの人が自分で作って使ってるけど、それを隠しているコマンドですね!!

Posted by 恥ずかしいので匿名 at 2007年03月27日 03:05

「FreeBSD 6-Stableの/usr/ports」ってなんだろう。
portsに6-STABLEという概念はなく、あるのは幹とリリースタグだけですよ。

Posted by 匿名 at 2007年03月27日 21:16

匿名さん、
/usr/portsでなく/usr/srcでした。おかげでtypoに気づきました。
Dan the Typo Generator

Posted by 弾 at 2007年03月28日 01:04