File Coverage

blib/lib/Thesaurus.pm

Criterion	Covered	Total	%
statement	67	69	97.1
branch	14	20	70.0
condition			n/a
subroutine	13	13	100.0
pod	5	5	100.0
total	99	107	92.5

package Thesaurus;

use strict;

use vars qw[$VERSION];

$VERSION = '0.23';

use Params::Validate qw( validate_with BOOLEAN );

sub new
{
    my $class = shift;
    my %p = validate_with( params => \@_,
                           spec => { ignore_case => { type => BOOLEAN, default => 0 },
                                   },
                           allow_extra => 1,
                         );

    my $self = bless { params => { ignore_case => delete $p{ignore_case},
                                 }
                     }, $class;

    $self->_init(%p);

    return bless $self, $class;
}

sub _init
{
    my $self = shift;

    $self->{data} = {};
}

sub add
{
    my $self = shift;

    foreach my $list (@_)
    {
        $self->_add_list($list);
    }
}

sub _add_list
{
    my $self = shift;
    my $list = shift;

    my %items = $self->_hash_from_list($list);

    while ( my ($k, $v) = each %items )
    {
        $self->{data}{$k} = $v;
    }
}

sub _hash_from_list
{
    my $self = shift;
    my $list = shift;

    # if we have any of these already, we need to create new lists for
    # them
    my @new =
        map { $self->find($_) } $self->_normalize_list($list);

    # return a unique list
    my @unique = keys %{ { map { $_ => 1 } @new, @$list } };

    # a hash of keys to values
    return map { ( $self->{params}{ignore_case} ? lc $_ : $_ ) => \@unique } @unique;
}

sub find
{
    my $self = shift;

    my $lists = $self->_find(@_);

    if (@_ > 1)
    {
        return unless %$lists;
        return %$lists;
    }
    else
    {
        return unless exists $lists->{ $_[0] };
        return @{ $lists->{ $_[0] } };
    }
}

sub _find
{
    my $self = shift;

    my %lists;
    foreach my $key (@_)
    {
        my $search_key = $self->{params}{ignore_case} ? lc $key : $key;

        # ignore duplicates
        next if exists $lists{$key};

        # Anonymize to keep people away from our lists!
        $lists{$key} =
            exists $self->{data}{$search_key} ? [ @{ $self->{data}{$search_key} } ] : [];
    }

    return \%lists;
}

sub delete
{
    my $self = shift;

    foreach my $item ( $self->_normalize_list(\@_) )
    {
        next unless exists $self->{data}{$item};

        foreach my $key ( @{ $self->{data}{$item} } )
        {
            delete $self->{data}{$key};
        }
    }
}

sub all
{
    my $self = shift;

    my (%done, @data);
    foreach my $key ( keys %{ $self->{data} } )
    {
        next if exists $done{$key};

        @done{ @{ $self->{data}{$key} } } = ();

        push @data, $self->{data}{$key};
    }

    return @data
}

sub _normalize_list
{
    my $self = shift;
    my $list = shift;

    return map { lc } @$list if $self->{params}{ignore_case};
    return @$list;
}

1;

__END__