File Coverage

blib/lib/Parqus.pm

Criterion	Covered	Total	%
statement	44	45	97.7
branch	14	16	87.5
condition			n/a
subroutine	9	9	100.0
pod	0	1	0.0
total	67	71	94.3

package Parqus;
$Parqus::VERSION = '0.05';
use Moo;
use namespace::autoclean;
use Regexp::Grammars;

# ABSTRACT: parse a search query string


has keywords => (
    is  => 'lazy',
    isa => sub {
        die "$_[0] is not a HashRef!"
          if ref $_[0] ne 'HASH';
    },
    coerce => sub {
        if ( ref $_[0] eq 'ARRAY' ) {
            my %hash = map { $_ => 1 } @{ $_[0] };
            return \%hash;
        }
        else {
            return $_[0];
        }
    },
    default => sub { {} }
);


has value_regex => (
    is  => 'lazy',
    isa => sub {
        die"$_[0] is not a Regexp!"
          unless ref $_[0] eq 'Regexp';
    },
    default => sub { qr![\w-]+!xms },
);

has string_delimiters => (
    is  => 'lazy',
    isa => sub {
        die "$_[0] is not a ArrayRef!"
          if ref $_[0] ne 'ARRAY';
    },
    default => sub { [qw/'"/] }
);

has parser => (
    is       => 'lazy',
    init_arg => undef,
    isa      => sub {
        die "$_[0] is not a Regexp!"
          unless ref $_[0] eq 'Regexp';
    },
);

sub _build_parser {
    my ($self) = @_;

    my %keywords          = %{ $self->keywords };
    my $value_regex       = $self->value_regex;
    my @string_delimiters = @{ $self->string_delimiters };
    return eval q{
                  use re 'eval'; # for perl <= 5.16.3
                  qr/

                    ^
                    <.ws>
                    <[query]>*
                    <.ws>
                    $

                        |

                        |

                        :<.ws>?

                        <%keywords>

                        [@string_delimiters]

                        |
                 /xms};
}

sub process {
    my ( $self, $query ) = @_;

    my %keywords = ();
    my @words    = ();
    my @errors   = ();
    if ( $query =~ $self->parser ) {
        for my $item ( @{ $/{query} } ) {
            if ( exists $item->{item}{keyvalue} ) {
                my $key = $item->{item}{keyvalue}{key};
                my $value =
                  exists $item->{item}{keyvalue}{value}
                  ? $item->{item}{keyvalue}{value}
                  : '';
                push( @{ $keywords{$key} }, $value );
            }
            elsif ( exists $item->{item}{value} ) {
                push( @words, $item->{item}{value} );
            }
            else {
                push( @errors, "Parse Error: neither word nor keyvalue" );
            }
        }
    }
    else {
        push( @errors, "Parse Error: Invalid search query." );
    }

    push( @errors, @! )
      if @!;

    return {
        ( scalar @words ? (words => \@words) : () ),
        ( scalar keys %keywords ? (keywords => \%keywords) : () ),
        ( scalar @errors ? (errors => \@errors) : () ),
    };
}

1;

__END__