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 10     10   66 use strict;
  10         15  
  10         276  
4 10     10   49 use warnings;
  10         19  
  10         8030  
5            
6             our $VERSION = '1.011';
7             $VERSION = eval $VERSION;
8            
9             sub __union
10             {
11 79     79   135 my $l = shift;
12 79         120 my $r = shift;
13            
14 79         181 return __unionOrIntersection($l, $r, 0);
15             }
16            
17             sub __intersection
18             {
19 344     344   557 my $l = shift;
20 344         480 my $r = shift;
21            
22 344         722 return __unionOrIntersection($l, $r, 1);
23             }
24            
25             sub __difference
26             {
27 57     57   104 my $l = shift;
28 57         84 my $r = shift;
29            
30 57         88 my %diff;
31 57         260 foreach my $item (keys(%$r))
32             {
33 1413 100       2686 $diff{$item} = $r->{$item} unless exists($l->{$item});
34             }
35            
36 57         201 return \%diff;
37             }
38            
39             sub __unionOrIntersection
40             {
41 423     423   617 my $l = shift;
42 423         581 my $r = shift;
43 423         564 my $modeIntersection = shift;
44            
45 423         641 my %union;
46             my %intersect;
47            
48 423         1941 foreach my $e (keys(%$l), keys(%$r))
49             {
50 8402 100       15787 $union{$e}++ && $intersect{$e}++;
51             }
52            
53 423 100       1196 my $h = $modeIntersection ? \%intersect : \%union;
54            
55 423         614 my %answer;
56 423   66     3822 $answer{$_} = ($l->{$_} || $r->{$_}) foreach (keys(%$h));
57            
58 423         2606 return \%answer;
59             }
60            
61             ### INDIVIDUAL OPERATIONS
62            
63             ## disj
64            
65             package Grep::Query::Parser::QOPS::disj;
66            
67             sub xeq
68             {
69 414     414   708 my $self = shift;
70 414         648 my $fieldAccessor = shift;
71 414         570 my $data = shift;
72            
73 414         957 my $answer = $self->{conj}->xeq($fieldAccessor, $data);
74 414 100       920 if (exists($self->{__ALT}))
75             {
76 79         125 foreach my $alt (@{$self->{__ALT}})
  79         219  
77             {
78 79         197 $answer = Grep::Query::Parser::QOPS::__union($answer, $alt->{conj}->xeq($fieldAccessor, $data));
79             }
80             }
81            
82 414         2706 return $answer;
83             }
84            
85             ## conj
86            
87             package Grep::Query::Parser::QOPS::conj;
88            
89             sub xeq
90             {
91 493     493   781 my $self = shift;
92 493         659 my $fieldAccessor = shift;
93 493         684 my $data = shift;
94            
95 493         969 my $answer = $self->{unary}->xeq($fieldAccessor, $data);
96 493 100       1093 if (exists($self->{__ALT}))
97             {
98 203         328 foreach my $alt (@{$self->{__ALT}})
  203         515  
99             {
100 344 50       1017 next unless keys(%$answer);
101 344         871 $answer = Grep::Query::Parser::QOPS::__intersection($answer, $alt->{unary}->xeq($fieldAccessor, $data));
102             }
103             }
104            
105 493         951 return $answer;
106             }
107            
108             ## unary
109            
110             package Grep::Query::Parser::QOPS::unary;
111            
112             sub xeq
113             {
114 837     837   1280 my $self = shift;
115 837         1111 my $fieldAccessor = shift;
116 837         1107 my $data = shift;
117            
118 837 100       1690 my $o = exists($self->{disj}) ? $self->{disj} : $self->{field_op_value_test};
119 837         1599 my $answer = $o->xeq($fieldAccessor, $data);
120 837 100       1911 $answer = Grep::Query::Parser::QOPS::__difference($answer, $data) if $self->{not};
121            
122 837         1693 return $answer;
123             }
124            
125             ## atom
126            
127             package Grep::Query::Parser::QOPS::field_op_value_test;
128            
129             sub xeq
130             {
131 738     738   1014 my $self = shift;
132 738         974 my $fieldAccessor = shift;
133 738         953 my $data = shift;
134            
135 738         955 my %answer;
136             grep
137             {
138 738         2950 my $rv = $data->{$_};
  17424         25908  
139 17424 100       39878 my $v = defined($fieldAccessor) ? $fieldAccessor->access($self->{field}, $$rv) : $$rv;
140 17424 100       337384 $answer{$_} = $rv if $self->{op}->($v, $self->{value}, $$rv);
141 17424         118991 0;
142             } keys(%$data);
143            
144 738         2399 return \%answer;
145             }
146            
147             1;