File Coverage

lib/Search/QS/Filters.pm
Criterion Covered Total %
statement 61 61 100.0
branch 10 12 83.3
condition n/a
subroutine 11 11 100.0
pod 4 4 100.0
total 86 88 97.7


line stmt bran cond sub pod time code
1             package Search::QS::Filters;
2             $Search::QS::Filters::VERSION = '0.03';
3 5     5   1087 use v5.14;
  5         14  
4 5     5   23 use Moose;
  5         11  
  5         23  
5 5     5   28054 use Search::QS::Filter;
  5         15  
  5         206  
6              
7 5     5   42 use feature 'switch';
  5         8  
  5         4597  
8              
9             extends 'Set::Array';
10              
11             # ABSTRACT: A collection of L<Search::QS::Filter>
12              
13              
14             sub parse() {
15 7     7 1 12 my $s = shift;
16 7         10 my $struct = shift;
17              
18              
19 7         25 while (my ($k,$v) = each %$struct) {
20 21         1065 given($k) {
21 21         66 when (/^flt\[(.*?)\]/) { $s->_parse_filter($1, $v) }
  17         33  
22             }
23             }
24             }
25              
26             sub _parse_filter {
27 17     17   23 my $s = shift;
28 17         27 my $kt = shift;
29 17         22 my $val = shift;
30              
31 17         67 my ($key, $tag) = split(/:/,$kt);
32              
33 17         404 my $fltObj = new Search::QS::Filter(name => $key, tag => $tag);
34 17         58 $fltObj->parse($val);
35 17         51 $s->push($fltObj);
36             }
37              
38             sub to_qs() {
39 17     17 1 2049 my $s = shift;
40 17         56 return join('&', map($_->to_qs, $s->compact() ));
41             }
42              
43             sub to_sql() {
44 5     5 1 296 my $s = shift;
45 5         14 my $groups = $s->as_groups;
46              
47 5         11 my $and = '';
48 5         7 while (my ($k, $v) = each %{$groups->{and}}) {
  7         28  
49 2         7 $and .= ' ( ' . join (' AND ', map($_->to_sql, @$v)) . ' ) ';
50 2         5 $and .= ' OR ';
51             }
52             # strip last OR
53 5 100       13 $and = substr($and, 0, length($and)-4) if (length($and) >0);
54              
55 5         7 my $or = '';
56 5         8 while (my ($k, $v) = each %{$groups->{or}}) {
  6         19  
57 1         4 $or .= ' ( ' . join (' OR ', map($_->to_sql, @$v)) . ' ) ';
58 1         3 $or .= ' AND ';
59             }
60             # strip last AND
61 5 100       13 $or = substr($or, 0, length($or)-5) if (length($or) >0);
62              
63 5         7 my $ret = join(' AND ', map($_->to_sql, @{$groups->{nogroup}}));
  5         16  
64              
65 5 50       16 $ret .= (length($ret) > 0 ? ' AND ' : '') . $and if ($and);
    100          
66 5 50       20 $ret .= (length($ret) > 0 ? ' AND ' : '') . $or if ($or);
    100          
67              
68 5         126 return $ret;
69             }
70             sub as_groups() {
71 5     5 1 8 my $s = shift;
72 5         8 my (%and, %or, @nogroup);
73             $s->foreach(sub {
74 11     11   52 given($_) {
75 11         242 when (defined $_->andGroup) {push @{$and{$_->andGroup}}, $_}
  4         5  
  4         76  
76 7         135 when (defined $_->orGroup) {push @{$or{$_->orGroup}}, $_}
  2         3  
  2         39  
77 5         7 default {push @nogroup, $_}
  5         12  
78             }
79 5         34 });
80 5         278 return { and => \%and, or => \%or, nogroup => \@nogroup};
81             }
82              
83              
84 5     5   37 no Moose;
  5         10  
  5         28  
85             __PACKAGE__->meta->make_immutable(inline_constructor => 0);
86              
87             1;
88              
89             __END__
90              
91             =pod
92              
93             =encoding UTF-8
94              
95             =head1 NAME
96              
97             Search::QS::Filters - A collection of L<Search::QS::Filter>
98              
99             =head1 VERSION
100              
101             version 0.03
102              
103             =head1 SYNOPSIS
104              
105             use Search::QS::Filters;
106              
107             my $flts = new Search::QS::Filters;
108             # parse query_string
109             $flts->parse_qs($qs);
110             # reconvert object to query_string
111             print $flts->to_qs;
112              
113             =head1 DESCRIPTION
114              
115             This object incapsulate multiple filter elements as a collection of
116             L<Search::QS::Filter>
117              
118             =head1 METHODS
119              
120             =head2 parse($perl_struct)
121              
122             $perl_struct is an HASHREF which represents a query string like
123             the one returned by L<URI::Encode/"url_params_mixed">.
124             It parses the struct and extract filter informations
125              
126             =head2 to_qs()
127              
128             Return a query string of the internal rappresentation of the object
129              
130             =head2 to_sql
131              
132             Return this object as a SQL search
133              
134             =head2 as_groups()
135              
136             Return an HASHREF with 3 keys:
137              
138             =over
139              
140             =item and
141              
142             An HASHREF with keys the andGroup keys and elements the filters with the
143             same andGroup key
144              
145             =item or
146              
147             An HASHREF with keys the orGroup keys and elements the filters with the
148             same orGroup key
149              
150             =item nogroup
151              
152             An ARRAYREF with all filters non in a and/or-Group.
153              
154             =back
155              
156             =head1 AUTHOR
157              
158             Emiliano Bruni <info@ebruni.it>
159              
160             =head1 COPYRIGHT AND LICENSE
161              
162             This software is copyright (c) 2019 by Emiliano Bruni.
163              
164             This is free software; you can redistribute it and/or modify it under
165             the same terms as the Perl 5 programming language system itself.
166              
167             =cut