verzia 1.2, 2005/05/24 11:55:46 |
verzia 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"; |
|
} |
} |
} |
} |
|
|