#!/usr/bin/perl
#
# Find files which have exact or
# almost the same name in a path.
#-----------------
# Author : Trizen
# License: GPLv3
# Appname: ampath
# Version: 0.0.2
#-----------------
# Created on 27 December 2011
# Latest edit on 18 February 2012
# http://trizen.googlecode.com

use 5.010;
use strict;
use warnings;

sub usage {
    print <<"HELP";
usage: $0 [options] [paths]
\nOptions:
    -a=<NUM>  : amount of approximateness (default: 0)
    --hidden  : verify hidden files and folders\n
HELP
    exit 0;
}

usage() if not @ARGV or grep { $_ ~~ ['-h', '--help'] } @ARGV;

my ($AMOUNT_DIFF, $show_hidden_files);

foreach my $arg (@ARGV) {
    next unless chr ord $arg eq '-';
    if ($arg =~ /^-+a=(\d+)$/ and $1 > 0) {
        $AMOUNT_DIFF = $1 + 1;
    }
    elsif ($arg =~ /^-+hidden$/) {
        $show_hidden_files = 1;
    }
}

my @files;

sub locate_files {
    foreach my $dir (@{$_[0]}) {
        $dir = readlink $dir and chop $dir if -l $dir;
        next unless opendir(my $dir_h, $dir);

        my @dirs;
        while (defined(my $file = readdir $dir_h)) {
            if ($show_hidden_files) {
                if ($file ~~ ['.', '..']) {
                    next;
                }
            }
            else {
                next if chr ord $file eq '.';
            }
            if (-d "$dir/$file") {
                push @dirs, "$dir/$file";
            }
            elsif (-f _) {
                push @files, {lc $file, "$dir/$file", 'file', lc $file};
            }
        }
        closedir $dir_h;
        locate_files(\@dirs);
    }
}

sub editdist {
    my %h;
    $h{$_}++ for split //, lc shift;
    $h{$_}-- for split //, lc shift;
    my $t = 0;
    $t += ($_ > 0 ? $_ : -$_) for values %h;
    $t;
}

sub find_similar_names {
    my ($name, $array_ref) = @_;

    my (@names) = (
        sort { $$a[1] <=> $$b[1] } grep({defined} map({
                 my $d = editdist($_, $name);
                   $d < $AMOUNT_DIFF ? [$_, $d] : undef;
                } grep({$_ ne $name} @$array_ref)))
    );

    if (@names) {
        my $best = $names[0][1];
        @names = map({$$_[0]} grep({$$_[1] == $best} @names));
    }

    \@names;
}

sub diff {
    my %alike;
    my %table;
    my @found;

    if (defined $AMOUNT_DIFF) {
        my (@names) = map({$$_{'file'}} @files);

        foreach my $file (@files) {

            my (@names) = map { $$_{'file'} }
              grep {

                my $length_1 = length $$_{'file'};
                my $length_2 = length $$file{'file'};

                $length_1 <= $length_2 + $AMOUNT_DIFF and $length_1 >= $length_2 - $AMOUNT_DIFF
                  or $length_1 == $length_2
                  if $$_{'file'} ne $$file{'file'};

              } @files;

            push @{$table{$$file{$$file{'file'}}}}, @{find_similar_names $$file{'file'}, \@names};
        }

        foreach my $array_1_ref (values %table) {
            next unless $array_1_ref;
            while (my ($file, $array_2_ref) = each %table) {
                if (@{$array_2_ref} and $array_1_ref ~~ $array_2_ref) {
                    $alike{$file} = ();
                }
            }
        }
        return +(sort { lc substr($a, rindex($a, '/')) cmp lc substr($b, rindex($b, '/')) } keys %alike);
    }
    else {
        foreach my $file (@files, @files) {
            $alike{$$file{$$file{'file'}}} = () if $table{$$file{'file'}}++ >= 2;
        }
        return
          +(sort { lc substr($a, rindex($a, '/')) cmp lc substr($b, rindex($b, '/')) }
            grep({length} keys %alike));
    }
}

foreach my $arg (@ARGV) {
    $arg =~ s[(?<=.)/+$][];
    my (@dir) = -d $arg ? $arg : next;
    local $, = "\n";
    say diff(locate_files(\@dir));
    undef @files;
}