File Coverage

blib/lib/Data/Seek/Search.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	7	8	87.5
condition	3	6	50.0
subroutine	6	6	100.0
pod	3	3	100.0
total	63	67	94.0

# ABSTRACT: Data::Seek Search Execution Class
package Data::Seek::Search;

use Data::Seek::Exception;
use Data::Seek::Search::Result;

use Data::Object::Class;

our $VERSION = '0.08'; # VERSION

has 'cache' => (
    is      => 'rw',
    default => 0
);

has 'criteria' => (
    is      => 'rw',
    default => sub {{}}
);

has 'data' => (
    is      => 'ro',
    default => sub {{}}
);

has 'data_cache' => (
    is      => 'ro',
    default => sub { shift->data->encode },
    lazy    => 1
);

has 'ignore' => (
    is      => 'rw',
    default => 0
);

sub criterion {
    my $self = shift;
    my $expr = shift;

    Data::Seek::Exception->throw(message => 'Invalid Criterion Provided')
        unless $expr && $expr =~ /^[\*\@\%\w\:\.]+$/;

    $self->criteria->{$expr} = keys %{$self->criteria};

    return $self;
}

sub perform {
    my $self = shift;

    my $criteria = $self->criteria;
    $criteria = { reverse %$criteria };

    my $dataset = $self->cache ? $self->data_cache : $self->data->encode;

    my @orders = sort keys %$criteria;
    my @criteria = @$criteria{@orders};

    my @results;
    for my $criterion (@criteria) {
        my $regexp = quotemeta $criterion;

        # array selector
        $regexp =~ s/\\\.\\\@\\\./\:\\d+\./g;

        # trailing tail array selector
        $regexp =~ s/([\w\\\*]*(?:\w|\*))\\[\@\%]\B/$1:\\d+/g;
        # trailing step array selector
        $regexp =~ s/([\w\\\*]*(?:\w|\*))\\[\@\%]\\\./$1:\\d+\\\./g;

        # leading head array selector
        $regexp =~ s/\A\\[\@\%]([\w\\\*]*(?:\w|\*))/$1:\\d+/g;
        # leading step array selector
        $regexp =~ s/\\\.\\[\@\%]([\w\\\*]*(?:\w|\*))/\\\.$1:\\d+/g;

        # greedy wildcard selector
        $regexp =~ s/\\\*\\\*/[\\w\\:\\.]+/g;
        # wildcard selector
        $regexp =~ s/\\\*/\\w+/g;

        my @nodes = grep /^$regexp$/, sort keys %$dataset;
        Data::Seek::Exception->throw(message => "No Data Matched ($criterion)")
            if not @nodes and not $self->ignore;

        next unless @nodes;

        my $result = {nodes => [sort @nodes], criterion => $criterion};
        push @results, $result;
    }

    my $output = [];
    for my $result (@results) {
        $$result{dataset} = {map { $_ => $$dataset{$_} } @{$$result{nodes}}};
        push @$output, $result;
    }

    return $output;
}

sub result {
    return Data::Seek::Search::Result->new(
        search => shift
    );
}

1;

__END__