File Coverage

blib/lib/Lingua/ZH/CCDICT/Storage/InMemory.pm

Criterion	Covered	Total	%
statement	52	59	88.1
branch	6	8	75.0
condition	3	3	100.0
subroutine	10	12	83.3
pod	4	4	100.0
total	75	86	87.2

package Lingua::ZH::CCDICT::Storage::InMemory;

use strict;
use warnings;

use base 'Lingua::ZH::CCDICT';

use Params::Validate qw( validate SCALAR );

use Lingua::ZH::CCDICT::ResultItem;
use Lingua::ZH::CCDICT::ResultSet::Array;


sub new
{
    my $class = shift;
    my %p = validate( @_,
                      { file => { type => SCALAR, optional => 1 },
                      },
                    );

    my $self = bless {}, $class;

    $self->parse_source_file( $p{file} );

    return $self;
}

sub _real_add_entry
{
    my $self    = shift;
    my $unicode = shift;
    my $entry   = shift;

    foreach my $key ( keys %$entry )
    {
        next if $key eq 'english' || $key eq 'unicode';

        foreach my $val ( eval { @{ $entry->{$key} } } ? @{ $entry->{$key} } : $entry->{$key} )
        {
            # intentionally stringify to take advantage of
            # stringification overloading for romanizations
            push @{ $self->{$key}{"$val"} }, $unicode;
        }
    }

    $self->{unicode}{$unicode} = $entry;
    $self->{unicode}{$unicode}{unicode} = $unicode;
}

sub all_characters
{
    my $self = shift;

    return
        Lingua::ZH::CCDICT::ResultSet::Array->new
            ( results =>
              [ map { Lingua::ZH::CCDICT::ResultItem->new( %{ $self->{unicode}{$_} } ) }
                sort keys %{ $self->{unicode} } ]
            );
}

sub match_unicode
{
    my $self = shift;

    my %seen;
    my @chars = map { $seen{$_}++ ? () : $_ } sort @_;

    my @results;
    foreach my $char (@chars)
    {
        if ( exists $self->{unicode}{$char} )
        {
            push @results,
                Lingua::ZH::CCDICT::ResultItem->new( %{ $self->{unicode}{$char} } );
        }
    }

    return Lingua::ZH::CCDICT::ResultSet::Array->new( array => \@results );
}

sub _match
{
    my $self = shift;
    my $type = shift;

    return
        $self->match_unicode( map { @{ $self->{$type}{$_} } }
                              grep { exists $self->{$type}{$_} }
                              @_
                            );
}

sub entry_count
{
    return scalar keys %{ $_[0]->{unicode} };
}


1;

__END__