File Coverage

blib/lib/Text/Levenshtein/Damerau.pm

Criterion	Covered	Total	%
statement	50	51	98.0
branch	12	18	66.6
condition			n/a
subroutine	10	10	100.0
pod	4	4	100.0
total	76	83	91.5

package Text::Levenshtein::Damerau;
use 5.008_008; # for utf8, sorry legacy Perls
use strict;
use utf8;
use List::Util qw/reduce/;
require Exporter;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw/edistance/;
our $VERSION   = '0.41';

# To XS or not to XS...
unless ( _set_backend('Text::Levenshtein::Damerau::XS::xs_edistance') ) {
    _set_backend('Text::Levenshtein::Damerau::PP::pp_edistance');
}

sub new {
    my $class = shift;
    my $self  = {};

    $self->{'source'}       = shift;
    $self->{'max_distance'} = 0;
    bless( $self, $class );

    return $self;
}

sub dld {
    my $self = shift;
    my $args = shift;

    if ( !ref $args ) {
        return edistance( $self->{'source'}, $args, );
    }
    elsif ( ref $args->{'list'} eq ref [] ) {
        my $target_score;

        if ( defined( $args->{'backend'} ) ) {
            _set_backend( $args->{'backend'} );
        }

        foreach my $target ( @{ $args->{'list'} } ) {
            my $ed =
              edistance( $self->{'source'}, $target, $args->{max_distance} );
            $target_score->{$target} = $ed if ( $ed >= 0 );
        }

        return $target_score;

    }
}

sub dld_best_match {
    my $self = shift;
    my $args = shift;

    if ( defined( $args->{'list'} ) ) {
        my $hash_ref = $self->dld($args);

        #Get the hashref key with the smallest value
        return reduce { $hash_ref->{$a} < $hash_ref->{$b} ? $a : $b }
        keys %{$hash_ref};
    }
}

sub dld_best_distance {
    my $self = shift;
    my $args = shift;

    if ( defined( $args->{'list'} ) ) {
        return $self->dld( $self->dld_best_match($args) );
    }
}

sub _set_backend {
    my $be = my $mod = shift;
    $mod =~ s/^(.*)::.*?$/$1/;

    local $@;
    eval "require $mod";
    unless ($@) {
	 eval "defined &$be";
        unless($@) {
            # We welcome our new edistance overlord
            *edistance = \&$be;
	     return 1;
        }
    }

    return 0;
}

1;

__END__