Remove (nearly) duplicate files recursively

Dearest Monks,

I have near-duplicate files in deeply nested directories. The duplicates are appended with " 1" as in "Mack the Knife 1.mp3". The duplicates are found together in the same directories. I would like to be able to locate potential duplicates (with regex), then check to see if a counterpart (without the " 1" is located in the directory. If the counterpart exists, rename. If not, then it's not a "duplicate", so do nothing. The best I can do is find the " 1.mp3" files and move them. How can I check for the counterpart? TIA.

#!/usr/bin/perl -w
use strict;

use File::Find;
find(\&process, '/Users/Shared/Music');

sub process {
    if (/[\d\D]*(?<!No\.)\s+1.mp3$/) {
        rename "$File::Find::name", "/Users/wrinkles/dupes/$_"
        or die $!;
        print "$File::Find::name removed. \n";
    }
}
[download]

The regex checks for a trailing " 1" that is not preceded with "No.". If I can check against the counterpart file, the look-behind check for "No." won't be necessary.

Comment on Remove (nearly) duplicate files recursively Download Code
Re: Remove (nearly) duplicate files recursively by moritz (Cardinal) on May 19, 2008 at 09:27 UTC
`my $orig = $File::Find::name; $orig =~ s/ 1\.mp3/.mp3/; if (-e $orig){ print "Counterpart exists\n"; }` [download] Update: fixed substitution, linuxer++	[reply] [d/l]
Re^2: Remove (nearly) duplicate files recursively by linuxer (Deacon) on May 19, 2008 at 09:48 UTC
small correction in the substitution `$orig =~ s/ 1\.mp3/.mp3/;` [download]	[reply] [d/l]
Re^2: Remove (nearly) duplicate files recursively by wrinkles (Monk) on May 19, 2008 at 10:22 UTC
Thanks moritz, here's the updated code: `#!/usr/bin/perl -w use strict; use File::Find; find(\&process, '/Users/Shared/Music'); sub process { my $song = $File::Find::name; my $orig = $song; $orig =~ s/ 1\.mp3/.mp3/; if ( (m/[\d\D]*\s+1.mp3$/) && (-e $orig) ){ rename "$song", "/Users/wrinkles/dupes/$_" or die $!; print "$song removed. \n"; } }` [download]	[reply] [d/l]
Re: Remove (nearly) duplicate files recursively by pc88mxer (Vicar) on May 19, 2008 at 15:48 UTC
Just one little efficiency pointer -- you can perform the substitution and check if the file ends in `.mp3` with one `s///` call: `#!/usr/bin/perl -w use strict; use File::Find; find(\&process, '/Users/Shared/Music'); sub process { my $song = $File::Find::name; my $orig = $song; if ($orig =~ s/ 1\.mp3$/.mp3/ && -e $orig) { ... } }` [download]	[reply] [d/l] [select]


The stupid question is the question not asked
	PerlMonks

Remove (nearly) duplicate files recursively

The best material for plates (tableware) is: