view release on metacpan or  search on metacpan

lib/Catmandu/Store/OpenSearch/CQL.pm  view on Meta::CPAN

package Catmandu::Store::OpenSearch::CQL;

use Catmandu::Sane;

our $VERSION = '0.03';

use Catmandu::Util qw(require_package trim);
use CQL::Parser;
use Moo;
use Types::Standard qw(HashRef);
use Types::Common::String qw(NonEmptyStr);
use namespace::clean;
use feature qw(signatures);
no warnings qw(experimental::signatures);

has parser  => (is => 'lazy', init_arg => undef);
has mapping => (is => 'ro', isa => HashRef, required => 1);
has id_key  => (is => 'ro', isa => NonEmptyStr, required => 1);

my $RE_ANY_FIELD         = qr'^(srw|cql)\.(serverChoice|anywhere)$'i;
my $RE_MATCH_ALL         = qr'^(srw|cql)\.allRecords$'i;
my $RE_DISTANCE_MODIFIER = qr'\s*\/\s*distance\s*<\s*(\d+)'i;

sub _build_parser {
    CQL::Parser->new;
}

sub parse ($self, $query) {
    my $node = eval {$self->parser->parse($query);} or do {
        my $error = $@;
        die("cql error: $error");
    };
    $self->parse_node($node);
}

sub parse_node ($self, $node) {
    my $query = {};

    if ($node->isa('CQL::TermNode')) {
        $self->_parse_term_node($node, $query);
        return $query;
    }
    elsif ($node->isa('CQL::ProxNode')) {
        $self->_parse_prox_node($node, $query);
        return $query;
    }

    my @stack       = ($node);
    my @query_stack = (my $q = $query);

    while (@stack) {
        $node = shift @stack;
        $q    = shift @query_stack;

        if ($node->isa('CQL::ProxNode')) { # CQL::ProxNode is a subclass of CQL::BooleanNode
            $self->_parse_prox_node($node, $q);
        }
        elsif ($node->isa('CQL::BooleanNode')) {
            push @stack, $node->left, $node->right;
            push @query_stack, my $left = {}, my $right = {};
            if ($node->op eq 'and') {
                $q->{bool} = {must => [$left, $right]};
            }
            elsif ($node->op eq 'or') {
                $q->{bool} = {should => [$left, $right]};
            }
            else {
                $q->{bool} = {must => [$left, {bool => {must_not => [$right]}}]};
            }
        }
        elsif ($node->isa('CQL::TermNode')) {
            $self->_parse_term_node($node, $q);
        }
        else {
            Catmandu::Error->throw('cql error: unable to map node of class '.ref($node));
        }
    }