OK, so what started out as a bash script grew into a rather finicky Perl script. I used a bunch of parallel hashes, judging things by combinations duplicate names, identical file sizes and actually scoring the path name and taking the highest score. I ended up no using the file hashes, because I decided that the path names and file sizes were enough information.
It prints out a lot of debugging output, but mostly it is heirarchical: file name/file size/path name.
20021120 foggy morning, church - as.jpg 1476 184 /tank/pictures/9999-Source/2002/2002-12-00-bellingham/thumb 21850 185 /tank/pictures/9999-Source/2002/2002-12-00-bellingham 184 /tank/pictures/9999-Source/2002/2002-12-00-bellingham/thumb 4029 185 /tank/pictures/9999-Source/2002/2002-12-00-bellingham 184 /tank/pictures/9999-Source/2002/2002-12-00-bellingham/thumb 184 /tank/pictures/9999-Source/2002/2002-12-00-bellingham/.xvpics
And here is the script itself:
# copyright 2013 Jed Reynolds
#!/usr/bin/perl -w
use strict;
use warnings;
use Carp;
use Data::Dumper;
#use Data::Dumper::Perltidy;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Useqq = 1;
package main;
use constant {
FHASH => 0,
FNAME => 1,
FSIZE => 2,
FPATH => 3,
SCORE => 4,
LCNAME => 5,
KEEP => 100,
DUMP => -1,
DUNNO => 999,
};
our %file_names = ();
our %path_counts = ();
our %file_sizes = ();
our @records = ();
our %lcfname_map = ();
our @loser_files = (
'.project',
'.recent',
'.recent-1',
'.recent-2',
'.recent-3',
'.recent-4',
'.recent-5',
'thumbs.db',
'thumbs.db~',
'.picasa.ini',
'zpool.txt',
);
our @loser_str = (
'.xml',
'.html',
'thumbs.db',
'Thumbs.db',
'thumbs.db~',
'Thumbs.db~',
'.picasa.ini',
'z.pl',
'zpool.txt',
'.php',
'.ini',
'.pdf',
'.odt',
);
our @loser_paths = (
'pictures/Documents',
'AptanaStudio',
'100NIKON',
'101NIKON',
'102NIKON',
'100PENTX',
'101PENTX',
'102PENTX',
'100FUGI',
'101FUGI',
'102FUGI',
'100FUJI',
'101FUJI',
'102FUJI',
'DCIM',
'pictures/Pictures/lap',
'pictures/lap',
'pictures/pictures',
'Pictures/Pictures',
'Pictures/tank',
'tank/tank',
#'0000-incoming',
'pictures/mnt',
#'home/Pictures',
'pictures/bin',
'999-copied',
'Documents/Candela',
);
sub lcMapKeyOf {
my $ra_rec = shift;
die("asRecordKey: wants record ref,bye") if(!defined $ra_rec);
my $key = lc(@$ra_rec[FNAME]).";".@$ra_rec[FSIZE].";".@$ra_rec[FPATH];
return $key;
}
sub recordKeyOf {
my $ra_rec = shift;
die("asRecordKey: wants record ref,bye") if(!$ra_rec);
my $key = lc(@$ra_rec[FNAME]).";".@$ra_rec[FSIZE];
return $key;
};
sub areMultipleCopiesInLoserPath {
my $ra_rec = shift;
die("areMultipleCopies: norecord,bye") unless( $ra_rec );
my $rv = 0;
my $key = ::recordKeyOf($ra_rec);
my $path = @$ra_rec[FPATH];
my $num = $::path_counts{$key};
my $strikes = 0;
if ( $num > 1 ) {
for my $loser (@::loser_paths) {
if( index($path, $loser) > -1 ) {
$strikes += 1;
print STDERR "multi:$path - $num\n";
}
}
}
# if everthing is a trike then we want to
# judge it using score system
$rv = (($strikes > 0) && ($strikes < $num)) ? 1 : 0; return $rv; } #~sub sub hasLoserName { my $ra_rec = shift; my $fname = @$ra_rec[FNAME]; if( $fname ~~ @::loser_files ) { #print "\n$fname member of loser_files\n"; return 1; } for my $loser (@::loser_str) { if( index($fname, $loser) > -1) {
#print "\n$fname substr of loser_str $loser\n";
return 1;
}
}
for my $loser (@::loser_paths) {
if( index(@$ra_rec[FPATH], $loser) > -1 ) {
#print "\n".@$ra_rec[FPATH]." substr of loser_path $loser\n";
return 1;
}
}
return 0;
}
sub checkForShorterName {
my $rv = 0;
my $ra_rec = shift;
my $fname = shift;
my ($shorter) = ($fname =~ m/(.*)[~]+$/);
#print STDERR "shorter[$shorter] fname[$fname]\n";
my $nkey = lc($shorter).";".@$ra_rec[FSIZE];
if (defined $::path_counts{$nkey} && $::path_counts{$nkey} > 0) {
#print "LOSER: backup has existing copies $nkey\n";
$rv = 1;
return $rv;
}
#print "zero path_counts[$nkey] checking file_names[$shorter]\n";
my $rh_sizes = $::file_names{$shorter};
if (defined $rh_sizes ) {
my $num = keys %$rh_sizes;
if ($num > 1) {
#print "LOSER: existing copies of $nkey\n";
$rv = 1;
}
}
return $rv;
} #~sub
sub pathScore {
my $fpath = shift;
die("pathScore: blank path, bye.") if ($fpath eq "");
my $s ='/';
my $pre = '/tank/pictures/';
my $score = 0;
if ($fpath =~ /20\d\d/) {
my ($year) = ($fpath =~ m/(20\d\d)/);
$score += ((2013 - $year) * 10);
}
if ($fpath =~ /${pre}0100-Projects${s}\d{4}${s}.+$/ ) {
$score += 200;
}
elsif ($fpath =~ /${pre}Chris-Nelsen.+$/ ) {
$score += 170;
}
elsif ($fpath =~ /${pre}0100-Projects${s}\d{4}${s}\d{4}-\d{2}-\d{2}$/ ) {
$score += 160;
}
elsif ($fpath =~ /${pre}0100-Projects${s}\d{4}-\d{2}-\d{2}.+$/ ) {
$score += 155;
}
elsif ($fpath =~ /${pre}0100-Projects${s}\d{4}-\d{2}-\d{2}$/ ) {
$score += 150;
}
elsif ($fpath =~ /${pre}0100-Projects${s}\d{4}$/ ) {
$score += 140;
}
elsif ($fpath =~ /${pre}0100-Projects${s}333-dng$/ ) {
$score += 130;
}
elsif ($fpath =~ /${pre}0100-Projects.+$/ ) {
$score += 125;
}
elsif ($fpath =~ /${pre}0100-Projects$/ ) {
$score += 120;
}
elsif ($fpath =~ /${pre}9999-Source${s}\d{4}${s}\d{4}-\d{2}-\d{2}$/ ) {
$score += 100;
}
elsif ($fpath =~ /${pre}9999-Source${s}\d{4}${s}\d{4}.+$/ ) {
$score += 75;
}
elsif ($fpath =~ /${pre}9999-Source${s}\d{4}${s}.+$/ ) {
$score += 71;
}
elsif ($fpath =~ /${pre}9999-Source${s}\d{4}$/ ) {
$score += 60;
}
elsif ($fpath =~ /${pre}9999-Source${s}.+$/ ) {
$score += 40;
}
elsif ($fpath =~ /${pre}9999-Source$/ ) {
$score += 50;
}
elsif ($fpath =~ /${pre}(3p|gmaps)$/ ) {
$score += 60;
}
elsif ($fpath =~ /${pre}Roz.+$/ ) {
$score += 70;
}
elsif ($fpath =~ /${pre}[Ww]eb.+$/ ) {
$score += 3;
}
elsif ($fpath =~ /${pre}\d+-[Mm]ovies${s}?.*$/ ) {
$score += 10;
}
elsif ($fpath =~ /${pre}\d+-[Mm]ovie$/ ) {
$score += 10;
}
elsif ($fpath =~ /${pre}8888-[Ss]creensaver${s}?.*$/ ) {
$score += 2;
}
elsif ($fpath =~ /${pre}8888-[Ll]iam.*$/ ) {
$score += 60;
}
elsif ($fpath =~ /${pre}0200-[Dd]esk.*$/ ) {
$score += 50;
}
elsif ($fpath =~ /${pre}\d{4}-\d{2}-\d{2}${s}.+$/ ) {
$score += 41;
}
elsif ($fpath =~ /${pre}\d{4}-\d{2}-\d{2}$/ ) {
$score += 31;
}
elsif ($fpath =~ /${pre}\d{4}${s}\d{2}${s}\d{2}$/ ) {
$score += 30;
}
elsif ($fpath =~ /${pre}\d{4}${s}.+$/ ) {
$score += 21;
}
elsif ($fpath =~ /${pre}1000-print.*$/ ) {
$score += 20;
}
elsif ($fpath =~ /${pre}Pictures${s}9999-[Ss]ource.*$/ ) {
$score += 11;
}
elsif ($fpath =~ /${pre}Pictures${s}lap${s}00-pix.*$/ ) {
$score += 10;
}
elsif ($fpath =~ /${pre}(home|0000-incoming).+$/ ) {
$score += 2;
}
elsif ($fpath =~ /${pre}tank.+$/ ) {
$score += 2;
}
elsif ($fpath =~ /${pre}?$/ ) {
$score += 3;
}
else {
my $v = "########################################\n"
."##\n"
."##\tUNRATED\t$fpath\n"
."##\n"
."########################################\n";
die( $v );
}
if( $score > 0 && index($fpath, ".album") >= 0) {
$score -= 1;
}
if( $score > 0 && index($fpath, ".xvpics") >= 0) {
$score -= 1;
}
if( $score > 0 && index($fpath, "/thumb") >= 0) {
$score -= 1;
}
return $score;
} #~sub
#---------------------------------------------------------#
my $l=0;
while() {
chomp;
next if(m/^\s*$/);
print STDERR "HUH?" if( ! m/;/);
my @file_rec = split(';');
print STDERR "bad FHASH" if ($file_rec[FHASH] eq "");
print STDERR "bad FNAME" if ($file_rec[FNAME] eq "");
print STDERR "bad FSIZE" if ($file_rec[FSIZE] eq "");
print STDERR "bad FPATH" if ($file_rec[FPATH] eq "");
push(@file_rec, DUNNO); # score
push(@file_rec, lc($file_rec[FNAME])); # lc name
push(@records, \@file_rec);
my $lckey = lcMapKeyOf( \@file_rec );
$lcfname_map{ $lckey } = \@file_rec;
$l++;
}
close(STDIN);
$l = @records;
print "loaded $l records\n";
$l = 0;
print "building file path mapping\n";
for my $ra_rec (@records) {
## ##
## filename+size => path ##
## ##
my $key = recordKeyOf($ra_rec);
$file_sizes{$key} = [] if(! $file_sizes{$key});
push($file_sizes{$key}, @$ra_rec[FPATH]);
## ##
## filename => size => path ##
## ##
$key = lc(@$ra_rec[FNAME]);
$file_names{$key} = () if(! $file_names{$key});
$file_names{$key}{ @$ra_rec[FSIZE] } = [] if(! $file_names{$key}{ @$ra_rec[FSIZE] });
push( $file_names{$key}{ @$ra_rec[FSIZE] }, @$ra_rec[FPATH]);
}
print "pondering file path duplicates\n";
for my $ra_rec (@records) {
my $key = recordKeyOf($ra_rec);
my $ra_paths = $file_sizes{$key};
my $n = @$ra_paths;
die("no paths for $key ???\n") if (!$n);
$path_counts{$key} = $n;
}
#(sort { ($userids{$a} cmp $userids{$b}) || ($a cmp $b) } keys %userids)
my $putty = "\n\t\t";
my @sorted_keys = sort { ($path_counts{$b} <=> $path_counts{$a}) || ($a cmp $b) } keys %path_counts;
print "sorted path count keys\n";
for my $key (@sorted_keys) {
my $cnt = 0 + $path_counts{$key};
next if ($cnt == 1);
my @sorted_paths = sort @{ $file_sizes{$key} };
}
@sorted_keys = sort {$a cmp $b} keys %file_names;
# this is a heirarchy of various duplicate paths
my @sorted_sizes;
for my $key (@sorted_keys) {
my $rh_sizes = $file_names{$key};
@sorted_sizes = sort keys %$rh_sizes;
for my $fsize (@sorted_sizes) {
my $ra_paths = $rh_sizes->{$fsize};
}
}
##----------------------------------------------------##
## ##
## Now get down to JUDGING the files ##
## ##
##----------------------------------------------------##
for my $lcfname (sort keys %::file_names) {
my @fsize_keys = keys $::file_names{$lcfname};
my $fname_ct = 0;
my $msg = "\n$lcfname";
my %scores = ();
for my $fsize (sort @fsize_keys) {
$fname_ct++;
my $fpath_ct = @{$::file_names{$lcfname}{$fsize}};
$msg .= "\n\t$fsize\n";
for my $path (@{$::file_names{$lcfname}{$fsize}}) {
my $key = "$lcfname;$fsize;$path";
my $ra_rec = $lcfname_map{$key};
if (!defined $ra_rec) {
die( "NO RA_REC $key????" );
next;
}
if (!defined @$ra_rec[SCORE]) {
print STDERR "NO RA_REC score\n";
@$ra_rec[SCORE] = DUNNO;
}
my $score = 0;
$scores{$path} = $score;
if (@$ra_rec[FSIZE] < 4 ) {
@$ra_rec[SCORE] = DUMP;
next;
}
if ( hasLoserName( $ra_rec ) ) {
@$ra_rec[SCORE] = DUMP;
next;
}
if( areMultipleCopiesInLoserPath($ra_rec) ) {
@$ra_rec[SCORE] = DUMP;
next;
}
if ( $lcfname =~ /.*[~]+$/ && checkForShorterName( $ra_rec, $lcfname )) {
@$ra_rec[SCORE] = DUMP;
next;
}
$scores{$path} = pathScore( $path );
} #~for path
# now sort out the scores, keep the best
next if (keys %scores < 1 );
my $top = "";
for my $path ( sort{$scores{$b} <=> $scores{$a} } keys %scores ) {
#print STDERR "path: $path\n";
my $score = $scores{$path};
$msg .= "\t\t$score\t$path\n";
my $key = "$lcfname;$fsize;$path";
next if (!defined $lcfname_map{$key});
my $ra_rec = $lcfname_map{$key};
if (!defined $ra_rec) {
die( "NO RA_REC $key????" );
next;
}
#print STDERR "score:".@$ra_rec[SCORE]."\n";
if ($top eq "" && @$ra_rec[SCORE] == DUNNO) {
$top = $path;
@$ra_rec[SCORE] = KEEP;
}
elsif (@$ra_rec[SCORE] == DUNNO) {
@$ra_rec[SCORE] = DUMP;
}
}
} #~for size
print "\n$fname_ct\t$msg";
} # for lcname
for my $ra_rec (@records) {
if ( @$ra_rec[SCORE] == DUMP || @$ra_rec[SCORE] == KEEP) {
next;
}
if (@$ra_rec[FSIZE] < 4 ) { @$ra_rec[SCORE] = DUMP; next; } if ( hasLoserName( $ra_rec ) ) { @$ra_rec[SCORE] = DUMP; next; } if( areMultipleCopiesInLoserPath($ra_rec) ) { @$ra_rec[SCORE] = DUMP; next; } if ( @$ra_rec[FPATH] =~ /.*[~]+$/ && checkForShorterName( $ra_rec, @$ra_rec[FNAME] )) { @$ra_rec[SCORE] = DUMP; next; } my $score = 0; $score = pathScore( @$ra_rec[FPATH] ); @$ra_rec[SCORE] = ( $score > 0 ) ? KEEP : DUMP ;
}
#now go through and tally the number of items killed
our @winners = [];
our @losers = [];
our @undecided = [];
for my $ra_rec (@records) {
my $key = ::recordKeyOf($ra_rec);
if ( @$ra_rec[SCORE] == DUMP ) {
push @losers, $ra_rec;
#my $safety = 0+$path_counts{$key};
}
elsif ( @$ra_rec[SCORE] == KEEP ) {
#my $ct = 0+$path_counts{$key} ;
#my $ix = index($key, '~');
#if ( $ct > 1 ) {
# my $lckey = lcMapKeyOf( $ra_rec );
# my $ra_paths = $file_sizes{$key};
# my $m = "\n\t".join( "\n\t", @$ra_paths );
# print "WIN? $key: $m\n";
#}
#if ($ix > -1) {
# my $lckey = lcMapKeyOf( $ra_rec );
# print STDERR "WIN? $key [$lckey]: ct[$ct] backup-symbol[$ix]\n";
#}
push @winners, $ra_rec;
}
else {
print STDERR "UNDECIDED: $key\n";
push @undecided, $ra_rec;
}
}
my $msg = "There were ";
$msg .= @undecided;
$msg .= " undecided, ";
$msg .= @winners;
$msg .= " winners and ";
$msg .= @losers;
$msg .= " losers.\n";
print $msg;
my $fh;
for my $ra_rec (@undecided) {
next if( !defined $ra_rec || !defined @$ra_rec[FNAME]);
my $key = lcMapKeyOf( $ra_rec );
die( "RE-JUDGE>>>> $key\n");
}
open($fh, ">", "zz-keep-paths.txt");
for my $ra_rec (@winners) {
next if (!defined @$ra_rec[FPATH]);
next if (!defined @$ra_rec[FNAME]);
my $fq_name = @$ra_rec[FPATH]."/".@$ra_rec[FNAME];
print $fh "$fq_name\n";
}
close $fh;
open($fh, ">", "zz-discard-paths.txt");
for my $ra_rec (@losers) {
next if (!defined @$ra_rec[FPATH]);
next if (!defined @$ra_rec[FNAME]);
my $fq_name = @$ra_rec[FPATH]."/".@$ra_rec[FNAME];
print $fh "rm $fq_name\n";
}
close $fh;
#eof
Bitratchet 