109 lines
2.4 KiB
Perl
Executable file
109 lines
2.4 KiB
Perl
Executable file
#!/usr/bin/perl -w
|
|
|
|
# $Dwarf: safe_mv,v 1.5 2002/10/26 20:20:00 ward Exp $
|
|
# $Source$
|
|
|
|
#
|
|
# Scriptje om bestanden te moven, en bij het reeds bestaan van een bestand
|
|
# op de plek waar het naartoe gemoved wordt eerst even te vergelijken
|
|
# of ze identiek zijn. Zo nee, gaat de move niet door. Zo ja, delete
|
|
# te moven bestand.
|
|
#
|
|
# (C) 2001-2002 Ward Wouts
|
|
#
|
|
|
|
use File::Copy;
|
|
use Digest::MD5 qw(md5);
|
|
use Getopt::Long;
|
|
|
|
$DEBUG = 0;
|
|
|
|
&cmdline;
|
|
&process;
|
|
|
|
$opt_r = 1; # just get rid of that stupid message from -w
|
|
|
|
sub process {
|
|
foreach ( @sources ) {
|
|
$source = "$_";
|
|
$target = "$_";
|
|
$target =~ s/.*\///;
|
|
$target = $targetdir."/".$target;
|
|
if ( -e "$target" ) {
|
|
&compare($source, $target);
|
|
} elsif ( ! $opt_r ) {
|
|
if ( $DEBUG ) { print "mv $_ -> $target\n"; }
|
|
else { move("$_", "$target") or die "move failed: $!"; }
|
|
}
|
|
}
|
|
}
|
|
|
|
sub compare($$) {
|
|
my ($source_size, $target_size);
|
|
my (@source_stat, @target_stat);
|
|
print "Comparing... ";
|
|
# First compare size. If this differs, we're done quickly.
|
|
if ( (-s $source) == (-s $target) ) {
|
|
@source_stat = stat $source;
|
|
@target_stat = stat $target;
|
|
if (( $source_stat[1] == $target_stat[1] ) &&
|
|
( $source_stat[0] == $target_stat[0] )) {
|
|
print "Skipped $source & $target are one and the same!\n"
|
|
} else {
|
|
print "$source and $target are the same size\n" if $DEBUG;
|
|
$source_digest = &calc_md5($source);
|
|
print "source digest $source_digest\n" if $DEBUG;
|
|
$target_digest = &calc_md5($target);
|
|
print "source digest $target_digest\n" if $DEBUG;
|
|
if ( $source_digest eq $target_digest ) {
|
|
print "Files are the same. Deleting $source.\n";
|
|
unlink($source)
|
|
or die "Can't delete $source: $!\n";
|
|
} else {
|
|
print "Skipped mv $source -> $target files differ\n"
|
|
}
|
|
}
|
|
} else {
|
|
print "Skipped mv $source -> $target files differ\n";
|
|
}
|
|
}
|
|
|
|
sub calc_md5($) {
|
|
my ($file, $digest);
|
|
$file = shift;
|
|
$md5 = Digest::MD5->new;
|
|
open FILE, "<$file" or die "couldn't open file: $!\n";
|
|
seek(FILE, 0, 0);
|
|
$md5->reset;
|
|
$md5->addfile(FILE);
|
|
$digest = $md5->hexdigest;
|
|
close(FILE);
|
|
return $digest;
|
|
}
|
|
|
|
sub cmdline {
|
|
&GetOptions("h", "r");
|
|
|
|
&help if $opt_h;
|
|
|
|
if ($#ARGV < 1) { &help; }
|
|
|
|
$targetdir=pop(@ARGV);
|
|
if ( ! -d $targetdir ) { &help; }
|
|
if ( $DEBUG ) { print "$targetdir\n"; }
|
|
|
|
@sources = @ARGV;
|
|
}
|
|
|
|
sub help {
|
|
$opt_h = 1; # just get rid of that stupid message from -w
|
|
print << "EOT";
|
|
|
|
$0 [options] <files> <destination>
|
|
|
|
-h this help message
|
|
-r remove duplicates only, don't move files
|
|
|
|
EOT
|
|
exit 1;
|
|
}
|