File Coverage

blib/lib/Grep/Query/Parser/QOPS.pm
Criterion Covered Total %
statement 64 64 100.0
branch 19 20 95.0
condition 2 3 66.6
subroutine 10 10 100.0
pod n/a
total 95 97 97.9


line stmt bran cond sub pod time code
1             package Grep::Query::Parser::QOPS;
2            
3 9     9   56 use strict;
  9         16  
  9         242  
4 9     9   43 use warnings;
  9         16  
  9         6819  
5            
6             our $VERSION = '1.009';
7             $VERSION = eval $VERSION;
8            
9             sub __union
10             {
11 78     78   145 my $l = shift;
12 78         134 my $r = shift;
13            
14 78         204 return __unionOrIntersection($l, $r, 0);
15             }
16            
17             sub __intersection
18             {
19 381     381   629 my $l = shift;
20 381         584 my $r = shift;
21            
22 381         904 return __unionOrIntersection($l, $r, 1);
23             }
24            
25             sub __difference
26             {
27 54     54   94 my $l = shift;
28 54         98 my $r = shift;
29            
30 54         93 my %diff;
31 54         232 foreach my $item (keys(%$r))
32             {
33 1404 100       2745 $diff{$item} = $r->{$item} unless exists($l->{$item});
34             }
35            
36 54         201 return \%diff;
37             }
38            
39             sub __unionOrIntersection
40             {
41 459     459   721 my $l = shift;
42 459         687 my $r = shift;
43 459         652 my $modeIntersection = shift;
44            
45 459         738 my %union;
46             my %intersect;
47            
48 459         2250 foreach my $e (keys(%$l), keys(%$r))
49             {
50 9479 100       18057 $union{$e}++ && $intersect{$e}++;
51             }
52            
53 459 100       1325 my $h = $modeIntersection ? \%intersect : \%union;
54            
55 459         694 my %answer;
56 459   66     4385 $answer{$_} = ($l->{$_} || $r->{$_}) foreach (keys(%$h));
57            
58 459         2972 return \%answer;
59             }
60            
61             ### INDIVIDUAL OPERATIONS
62            
63             ## disj
64            
65             package Grep::Query::Parser::QOPS::disj;
66            
67             sub xeq
68             {
69 420     420   780 my $self = shift;
70 420         664 my $fieldAccessor = shift;
71 420         594 my $data = shift;
72            
73 420         1116 my $answer = $self->{conj}->xeq($fieldAccessor, $data);
74 420 100       1000 if (exists($self->{__ALT}))
75             {
76 78         139 foreach my $alt (@{$self->{__ALT}})
  78         214  
77             {
78 78         213 $answer = Grep::Query::Parser::QOPS::__union($answer, $alt->{conj}->xeq($fieldAccessor, $data));
79             }
80             }
81            
82 420         2884 return $answer;
83             }
84            
85             ## conj
86            
87             package Grep::Query::Parser::QOPS::conj;
88            
89             sub xeq
90             {
91 498     498   761 my $self = shift;
92 498         739 my $fieldAccessor = shift;
93 498         712 my $data = shift;
94            
95 498         1180 my $answer = $self->{unary}->xeq($fieldAccessor, $data);
96 498 100       1151 if (exists($self->{__ALT}))
97             {
98 216         375 foreach my $alt (@{$self->{__ALT}})
  216         579  
99             {
100 381 50       1180 next unless keys(%$answer);
101 381         972 $answer = Grep::Query::Parser::QOPS::__intersection($answer, $alt->{unary}->xeq($fieldAccessor, $data));
102             }
103             }
104            
105 498         1036 return $answer;
106             }
107            
108             ## unary
109            
110             package Grep::Query::Parser::QOPS::unary;
111            
112             sub xeq
113             {
114 879     879   1329 my $self = shift;
115 879         1218 my $fieldAccessor = shift;
116 879         1219 my $data = shift;
117            
118 879 100       1972 my $o = exists($self->{disj}) ? $self->{disj} : $self->{field_op_value_test};
119 879         1775 my $answer = $o->xeq($fieldAccessor, $data);
120 879 100       2101 $answer = Grep::Query::Parser::QOPS::__difference($answer, $data) if $self->{not};
121            
122 879         1962 return $answer;
123             }
124            
125             ## atom
126            
127             package Grep::Query::Parser::QOPS::field_op_value_test;
128            
129             sub xeq
130             {
131 771     771   1165 my $self = shift;
132 771         1135 my $fieldAccessor = shift;
133 771         1111 my $data = shift;
134            
135 771         1102 my %answer;
136             grep
137             {
138 771         3208 my $rv = $data->{$_};
  19176         29137  
139 19176 100       44736 my $v = defined($fieldAccessor) ? $fieldAccessor->access($self->{field}, $$rv) : $$rv;
140 19176 100       384153 $answer{$_} = $rv if $self->{op}->($v, $self->{value});
141 19176         38676 0;
142             } keys(%$data);
143            
144 771         2640 return \%answer;
145             }
146            
147             1;