#!/usr/bin/perl

=head1 NAME - dupefinder

dupefinder - finds (and can archive) duplicate files

=head1 DESCRIPTION

Download a lot of *cough* images or music? Forget if you've already downloaded
something? Then you probably have some duplicate files sitting around. This
script identifies duplicate files. It can also move them to a safe place
(optionally preserving directory structure) so you can examine them before
deleting. It uses C<md5> which is standard in FreeBSD systems. If you have
something else, e.g. a Linux system with C<md5sum>, you'll have to edit the line
that executes it script to make it work.

=head1 USAGE

Try C<-h> for a usage statement.

    dupefinder my_mp3s
    dupefinder --relocate=~/tmp/dups naughty_milkmaids
    dupefinder -h

=cut

use strict;

use Cwd;
use File::Path;
use File::Basename;
use File::Find;
use Getopt::Long;

my ( $verbose, $quiet, $relocate, $prompt, $newest, $keep_dirs, $test,
    $commands, );

Getopt::Long::Configure("bundling");
GetOptions(
    'help|h'              => \&usage,
    'verbose|v+'          => \$verbose,
    'quiet|q+'            => \$quiet,
    'relocate|move|m|r=s' => \$relocate,
    'prompt|p!'           => \$prompt,
    'newest|n!'           => \$newest,
    'keep-dirs|k!'        => \$keep_dirs,
    'test|t!'             => \$test,
    'commands|c!'         => \$commands,
);

my @args = ( @ARGV ? @ARGV : '.' );

my $commands = '# ' if ( $commands and $relocate );

foreach (@args) {
    warn "No such file or directory: $_" unless -e $_;
}

my $cwd = cwd();
find( \&wanted, @args );

my %sigs;

sub wanted {
    print "$commands\Checking $File::Find::name\n" if $verbose;
    return unless -f $_;
    my $md5 = `md5 '$_'`;
    $md5 =~ s/.* = (.*)\n/$1/;
    print "\tmd5: $md5\n" if $verbose > 1;

    if ( $sigs{$md5} ) {
        if ( not $relocate ) {
            print "$commands$sigs{$md5} = $File::Find::name\n";
        } else {

            # first check the preferred file to move
            my ($move_left,$move_right);
            if ( not $newest
                or ( stat("$cwd/$sigs{$md5}") )[9] <=
                ( stat("$cwd/$File::Find::name") )[9] )
            {
                $move_left  = $sigs{$md5};
                $move_right = $File::Find::name;
            } else {
                $move_left  = $File::Find::name;
                $move_right = $sigs{$md5};
            }

            my $move_this;

            # prompt if needed
            if ($prompt) {
                print "$move_left = $move_right\n";
                print "Move file on left "
                  . ( $newest ? ' (oldest)' : '' )
                  . ", file on right, or neither?  (LlRrNn)[n]: ";
                my $answer = <STDIN>;
                if ( $answer =~ m/L/i ) {
                    $move_this = $move_left;
                } elsif ( $answer =~ m/R/i ) {
                    $move_this = $move_right;
                } else {
                    print "Leaving file\n";
                }

            } else {
                $move_this = $move_right;
            }

            if ($move_this) {
                print "$commands$move_left = $move_right\n"
                  unless ( $prompt or $quiet );
                if ( $move_this eq $sigs{$md5} ) {
                    $sigs{$md5} = $File::Find::name;
                }

                # final path fixups
                my ($src,$target);
                if ($keep_dirs) {
                    $target = "$relocate/" . $move_this;
                    my $dir    = dirname($target);
                    if ( not -d $dir ) {
                        mkpath( [$dir], $verbose ) or return;
                    }
                } else {
                    $target = "$relocate/" . basename($move_this);
                }
                $src = "$cwd/$move_this";

                print
"$commands\tduplicate:\t$move_this\n$commands\tmove to:\t$target\n"
                  unless $quiet;
                rename $src, $target
                  or warn "Move failed ($move_this -> $target): $!"
                  unless ( $test or $commands );
                print "mv \"$src\" \"$target\"\n" if $commands;

            }

        }
    } else {
        $sigs{$md5} = $File::Find::name;
    }

}

sub usage {
    my $fn = basename($0);

    print STDERR <<EOF;
Usage: $fn [-hqv] [-r <dir>] <dirs_to_check>

This script finds duplicate files and optionally relocates the duplicates. By
default, the current directory is scanned: otherwise, whatever filename args you
specify. Not all options make sense with all others; e.g. -c doesn't do anything
without -r.

    -h                Help
    -q                Quiet
    -v                Verbose
    --relocate,-r,    Directory where you want to place duplicate files
    --move,-m
    --prompt,-p       Ask before moving files
    --newest,-n       Move newest file
    --keep-dirs,-k    Keep directory structure of moved files
    --test,t          Do everything except actually move it
    --commands,c      Don't move files, and output script-ready commands
EOF
    exit 1;
}

=head1 LICENSE

Copyright 2004,2005,2006 Jason Thaxter

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.