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.01';

=begin testing

  use Tie::Hash::Approx;
  my %hash;
  my $x = tie %hash, 'Tie::Hash::Approx';

  ok( ref $x eq 'Tie::Hash::Approx', "tie'ing hash to Tie::Hash::Appro
+x"); 

=end testing

=cut

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] };
    }
}

=begin testing

  %hash = (
    key  => 'value',
    kay  => 'another value',
    stuff => 'yet another stuff',
  );

  ok( $hash{key} eq 'value', 'exact match' );
  ok( $hash{staff} eq 'yet another stuff', 'approx match' );

=end testing

=begin testing

  @res{ tied(%hash)->FETCH('koy') }++;

  ok( exists($res{'value'}) && exists($res{'another value'}), 'wantarr
+ay approx match' );

=end testing

=cut

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

    return undef unless %{$this};

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

=begin testing

  ok( exists($hash{'key'}), 'exists exact match' );
  ok( exists($hash{'staff'}), 'exists approx match' );
  ok( !exists($hash{''}), 'exists empty match' );

=end testing

=cut

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 };
}

=begin testing

 delete $hash{koy};
 ok( !exists($hash{'key'}) && !exists($hash{'kay'}), 'deleting several
+ approx matches');

 delete $hash{staff};
 ok( !exists($hash{'staff'}), 'deleting approx match');

=end testing

=cut

1;

__END__

=head1 NAME

Tie::Hash::Approx - Approximative match of hash keys using String::App
+rox

=head1 SYNOPSIS

  use Tie::Hash::Approx;

  my %hash;
  tie %hash, 'Tie::Hash::Approx';

  %hash = (
    key  => 'value',
    kay  => 'another value',
    stuff => 'yet another stuff',
  );

  print $hash{'key'};  # prints 'value'
  print $hash{'koy'};  # prints 'another value' or 'value'
  print $hash{'staff'}; # prints 'yet another stuff'

  print tied(%hash)->FETCH('koy'); # prints 'value' and 'another value
+'

  delete $hash{kee};   # deletes $h{key} and $h{kay}

=head1 TODO

Add the possibility of configuring the 'fuzziness' of the match (cf.
the modifiers option in String::Approx).

=head1 AUTHOR

Briac Pilpre <briac @ pilpre . com >

Thanks to Dave Cross for making Tie::Hash::Regex in the first place!

=head1 SEE ALSO

perl(1). perltie(1). Tie::Hash. String::Approx

=cut