File Coverage

blib/lib/Tie/Hash/Approx.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	15	18	83.3
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	59	62	95.1

package Tie::Hash::Approx;
use strict;
use vars qw($VERSION @ISA);

require Exporter;
require Tie::Hash;

use String::Approx('amatch');

@ISA     = qw(Exporter Tie::StdHash);
$VERSION = '0.03';

sub FETCH {
    my $this = shift;
    my $key  = shift;

    return undef unless %{$this}; # return if the hash is empty

    # We return immediatly if an exact match is found
    return $this->{$key} if exists $this->{$key};

    # Otherwise, the fuzzy search kicks in
    my @results = amatch( $key, keys( %{$this} ) );


    # wantarray doesn't work on tied hash, unless
    # you're using a "tied(%hash)->FETCH('foo');"
    # construct
    if (wantarray) {
       return @{$this}{@results};
    }
    else {
      return $this->{ $results[0] };
    }
}

sub EXISTS {
    my $this = shift;
    my $key  = shift;

    return undef unless %{$this};
	if ( $key eq '' ){
		return 1 if exists $this->{''};
		return 0;
	}

    return 1 if exists $this->{$key};
    return 1 if amatch( $key, keys( %{$this} ) );
	return 0;
}


sub DELETE {
    my $this = shift;
    my $key  = shift;

    return delete $this->{$key} if exists $this->{$key};
    my @results = amatch( $key, keys( %{$this} ) );

    # This will delete *all* the keys matching!
    delete @{$this}{ @results };
}

1;

__END__