File Coverage

blib/lib/Parqus.pm
Criterion Covered Total %
statement 30 31 96.7
branch 14 16 87.5
condition n/a
subroutine 5 5 100.0
pod 0 1 0.0
total 49 53 92.4


line stmt bran cond sub pod time code
1             package Parqus;
2             $Parqus::VERSION = '0.02';
3 1     1   73355 use Moo;
  1         11291  
  1         5  
4 1     1   1919 use namespace::autoclean;
  1         13487  
  1         5  
5 1     1   1349 use Regexp::Grammars;
  1         25573  
  1         8  
6              
7             # ABSTRACT: parse a search query string
8              
9              
10             has keywords => (
11             is => 'lazy',
12             isa => sub {
13             die "$_[0] is not a HashRef!"
14             if ref $_[0] ne 'HASH';
15             },
16             coerce => sub {
17             if ( ref $_[0] eq 'ARRAY' ) {
18             my %hash = map { $_ => 1 } @{ $_[0] };
19             return \%hash;
20             }
21             else {
22             return $_[0];
23             }
24             },
25             default => sub { {} }
26             );
27              
28              
29             has value_regex => (
30             is => 'lazy',
31             isa => sub {
32             "$_[0] is not a Regexp!"
33             unless ref $_[0] eq 'Regexp';
34             },
35             default => sub { qr![\w-]+!xms },
36             );
37              
38             has parser => (
39             is => 'lazy',
40             init_arg => undef,
41             isa => sub {
42             "$_[0] is not a Regexp!"
43             unless ref $_[0] eq 'Regexp';
44             },
45             );
46              
47             sub _build_parser {
48 3     3   31 my ($self) = @_;
49              
50 3         5 my %keywords = %{ $self->keywords };
  3         48  
51 3         74 my $value_regex = $self->value_regex;
52 3         152 return eval q{qr/
53            
54             ^
55             \s*
56             <[query]>*
57             \s*
58             $
59            
60             |
61            
62             |
63            
64             :?
65            
66             <%keywords>
67            
68             ['"]
69            
70             |
71             /xms};
72             }
73              
74             sub process {
75 14     14 0 14686 my ( $self, $query ) = @_;
76              
77 14         28 my %keywords = ();
78 14         23 my @words = ();
79 14         23 my @errors = ();
80 14 100       341 if ( $query =~ $self->parser ) {
81 11         23 for my $item ( @{ $/{query} } ) {
  11         28  
82 13 100       38 if ( exists $item->{item}{keyvalue} ) {
    50          
83 4         10 my $key = $item->{item}{keyvalue}{key};
84             my $value =
85             exists $item->{item}{keyvalue}{value}
86             ? $item->{item}{keyvalue}{value}
87 4 50       15 : '';
88 4         6 push( @{ $keywords{$key} }, $value );
  4         15  
89             }
90             elsif ( exists $item->{item}{value} ) {
91 9         24 push( @words, $item->{item}{value} );
92             }
93             else {
94 0         0 push( @errors, "Parse Error: neither word nor keyvalue" );
95             }
96             }
97             }
98             else {
99 3         125 push( @errors, "Parse Error: Invalid search query." );
100             }
101              
102 14 100       43 push( @errors, @! )
103             if @!;
104              
105             return {
106 14 100       106 ( scalar @words ? (words => \@words) : () ),
    100          
    100          
107             ( scalar keys %keywords ? (keywords => \%keywords) : () ),
108             ( scalar @errors ? (errors => \@errors) : () ),
109             };
110             }
111              
112             1;
113              
114             __END__