# 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__

=pod

=encoding UTF-8

=head1 NAME

Data::Seek::Search - Data::Seek Search Execution Class

=head1 VERSION

version 0.08

=head1 SYNOPSIS

    use Data::Seek::Search;

=head1 DESCRIPTION

Data::Seek::Search is a class within L<Data::Seek> which provides the search
mechanism for introspecting data structures.

=head1 ATTRIBUTES

=head2 cache

    $search->cache;
    $search->cache(1);

Encode the data structure and cache the result. Allows multiple queries to
execute faster. Caching is disabled by default.

=head2 criteria

    $search->criteria;
    $search->criteria({
        '*'                       => 0,
        'person.name.first'       => 1,
        'person.name.last'        => 2,
        'person.settings.@.name'  => 3,
        'person.settings.@.type'  => 4,
        'person.settings.@.value' => 5,
    });

A collection of criterion which will be used to match nodes within the data
structure when introspected, in the order registered.

=head2 data

    $search->data;
    $search->data(Data::Seek::Data->new(...));

The data structure to be introspected, must be a hash reference, blessed or not,
which defaults to or becomes a L<Data::Seek::Data> object.

=head2 data_cache

    $search->data_cache;
    $search->data_cache(Data::Seek::Data->new(...)->encode);

The encoded data structure to be introspected, must be an encoded hash
reference, e.g. the result from calling the encode method on a
L<Data::Seek::Data> object.

=head2 ignore

    $search->ignore;
    $search->ignore(1);

Bypass exceptions thrown when a criterion is invalid or no data matches can be
found.

=head1 METHODS

=head2 criterion

    $search->criterion('*');

Register a criterion to be used to introspect the registered data structure. A
criterion is only valid if it begins with a array index, and array iterator, or
a node key; Also can only contain letters, numbers, underscores, periods, and
semi-colons.

=head2 perform

    my $dataset = $search->perform;

Introspect the data structure using the registered criteria and settings, and
return a result set of operations and matching data nodes.

=head2 result

    my $result = $search->result;

Return a search result object, L<Data::Seek::Search::Result>, based on the
current search object.

=head1 AUTHOR

Al Newkirk <anewkirk@ana.io>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2014 by Al Newkirk.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
