| version 1.2, 2005/05/24 11:55:46 |
version 1.3, 2005/05/24 12:31:28 |
|
|
| # 2005-04-17 - created |
# 2005-04-17 - created |
| # |
# |
| |
|
| # $Platon: scripts/perl/filesystem/hardlink-files.pl,v 1.1 2005/04/17 16:31:07 rajo Exp $ |
# $Platon: scripts/perl/filesystem/hardlink-files.pl,v 1.2 2005/05/24 11:55:46 rajo Exp $ |
| |
|
| use strict; |
use strict; |
| use File::Find; |
use File::Find; |
|
|
| open(FILE, $file) or die "Can't open file '$file': $!"; |
open(FILE, $file) or die "Can't open file '$file': $!"; |
| binmode(FILE); |
binmode(FILE); |
| my $md5 = Digest::MD5->new->addfile(*FILE)->hexdigest; |
my $md5 = Digest::MD5->new->addfile(*FILE)->hexdigest; |
| push @{$md5sums->{$md5}}, { |
push @{$md5sums->{$dev}->{$md5}}, { |
| filename => abs_path($file), |
filename => abs_path($file), |
| dir => $dir, |
dir => $dir, |
| dev => $dev, |
dev => $dev, |
|
|
| |
|
| #print Dumper($md5sums); |
#print Dumper($md5sums); |
| |
|
| print scalar(keys %$md5sums), " unique files found\n"; |
my $hashes; |
| |
foreach my $dev (keys %$md5sums) { |
| |
foreach my $key (keys %{$md5sums->{$dev}}) { |
| |
$hashes->{$key} = 1; |
| |
} |
| |
} |
| |
print scalar(keys %$hashes), " unique files found\n"; |
| |
|
| foreach my $key (keys %$md5sums) { |
foreach my $dev (keys %$md5sums) { |
| my $arr = $md5sums->{$key}; |
foreach my $key (keys %{$md5sums->{$dev}}) { |
| if (scalar(@$arr) > 1) { |
my $arr = $md5sums->{$dev}->{$key}; |
| my $source = $arr->[0]->{filename}; |
if (scalar(@$arr) > 1) { |
| my $inum = $arr->[0]->{ino}; |
my $source = $arr->[0]->{filename}; |
| print $source; |
my $inum = $arr->[0]->{ino}; |
| for (my $i = 1; $i < scalar(@$arr); $i++) { |
print $source; |
| print "\n\t<-- ", $arr->[$i]->{filename}; |
for (my $i = 1; $i < scalar(@$arr); $i++) { |
| if ($arr->[$i]->{ino} == $inum) { |
print "\n\t<-- ", $arr->[$i]->{filename}; |
| print " [already linked]"; |
if ($arr->[$i]->{ino} == $inum) { |
| } |
print " [already linked]"; |
| else { |
} |
| unlink $arr->[$i]->{filename} or warn "\n\nunlink error: $!\n"; |
else { |
| link $source, $arr->[$i]->{filename} or warn "\n\nlink error: $!\n"; |
unlink $arr->[$i]->{filename} or warn "\n\nunlink error: $!\n"; |
| |
link $source, $arr->[$i]->{filename} or warn "\n\nlink error: $!\n"; |
| |
} |
| } |
} |
| |
print "\n\n"; |
| } |
} |
| print "\n\n"; |
|
| } |
} |
| } |
} |
| |
|