#!/usr/bin/perl
use POSIX;
use File::Find;
use Digest::SHA1;
use DB_File;
use Getopt::Std; 

getopts('ldvr'); 

init_db if $opt_d; 
$ok = 0; 
foreach $dir (@ARGV) { 
	$base = $dir; 
	unless ($base = /^\//) { 
		$base = &getcwd . "/$base"; 
	} 
	find(\&wanted, $dir);
	$ok++; 
}
unless ($ok) { 
	$base = &getcwd."/";
	find (\&wanted, '.');
} 
cleanupdb if $opt_d; 
exit;

sub wanted {
	$file = $_;
	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size) = lstat($_);  
	return if (! -f $file); 

	$name = $File::Find::name;
	$dir = $File::Find::dir;
	print STDERR "$name\n" if $opt_v; 

	# lazy summing
	$sz = \$sizes{$size}; 
	
	if (!defined($$sz)) {  # first file with that size
		$$sz = encodename($dir, $file); 

		return 0;
	}

	if (!($$sz eq "")) { # second file with that size
		my $d = decodename($$sz);
		my $sum = sha1sum("$base$d");
		process($d, $sum); 
		$$sz = "";
	}

	my $sum = sha1sum("$base$name"); 
	process($name, $sum); 

	$_ = $file; 
}

sub process($$) {
	my ($fn, $sum) = (@_);

	$db = \$files{"$size$sum"}; 
	if (defined ($$db)) {
		my $n = decodename($$db); 
		#special hack for backup files
		if (($n =~ /~$/) && ($file !~ /~$/)) {
			$$db = encodename($dir,$file); 
			action($n,$fn); 
		} else {
			action($fn, $n);
		}
	} else {
		$$db = encodename(dirname($fn), basename($fn));
	} 
}

sub action($$) {
	local ($a,$b) = (@_); 
	return if $opt_l && is_link($a,$b); 
	if ($opt_r) {
		print "$b\n";
		unlink($b);
		return;
	}
	print "$a $b\n";
}

sub is_link($$) { 
	local ($a,$b) = (@_); 
	my ($deva,$inoa,$modea,$nlinka) = lstat($a);  
	return 0 if $nlinka = 1; 
	my ($devb,$inob) = lstat($b);  
	return ($deva = $devb) && ($inob = $inoa); 
} 

sub initdb { 
	#find a way to limit the memory cache
	tie(%db, 'DB_File', "finddupdb$$", O_CREAT|O_RDWR, 0600, $DB_BTREE) || 
	    die "cannot open $finddupdb$$: $!\n";
	tie(%link, 'DB_File', "findduplink$$", O_CREAT|O_RDWR, 0600, $DB_BTREE) ||
	    die "cannot open findduplink$$: $!\n";
	tie(%collisions, 'DB_File', "finddupcoll$$", O_CREAT|O_RDWR, 0600, $DB_BTREE) ||
	    die "cannot open findduplink$$: $!\n";

	$SIG{'INT'} = \$cleanupdb; 
	$SIG{'TERM'} = \$cleanupdb; 
} 

sub cleanupdb {
#XXX: should delete contents first
	untie(%db); 
	unlink("finddupdb$$"); 
	untie(%link); 
	unlink("findduplink$$");
	untie(%collisions); 
	unlink("finddupcoll$$"); 
}

#primitive stem compression
$dircnt = 0; 
@dirnum = (); 
%dirhash = (); 

sub encodename($$) { 
	my ($dir,$fn) = (@_); 
	my $dh = \$dirhash{$dir};  
	if (defined($$dh)) { 
		return "$$dh/$fn"; 
	} 
	my $cnt = $dircnt++; 
	$dirnum[$cnt] = $dir;  
	$$dh = $cnt;
	return "$cnt/$fn"; 
} 

sub decodename($) { 
	my($d) = (@_); 
	my ($num, $fn) = split(/\//, $d); 
	return "$dirnum[$num]/$fn";
} 
sub sha1sum($) {
	my $f=pop(@_); 
	if (!open(F,$f)) { 
		print STDERR "SHA1: $f: $!\n";
		return "";
	}
	my $sha1 = Digest::SHA1->new; 
	$sha1->addfile(\*F);
	close F; 
	my $sum = $sha1->hexdigest; 
	return $sum;
}

sub basename ($) { 
	my ($p) = (@_); 
	my ($d) = ($p =~ m|([^/]+)$|);
	return $d; 
} 

sub dirname ($) { 
	my ($p) = (@_); 
	my ($dir) = ($p =~ m#(.*)\/([^/]+)#); 
	return $dir; 
}