File Coverage

blib/lib/JQ/Lite/Parser.pm
Criterion Covered Total %
statement 130 146 89.0
branch 57 78 73.0
condition 19 33 57.5
subroutine 8 8 100.0
pod 0 1 0.0
total 214 266 80.4


line stmt bran cond sub pod time code
1             package JQ::Lite::Parser;
2              
3 176     176   1052 use strict;
  176         331  
  176         6714  
4 176     176   1097 use warnings;
  176         500  
  176         9968  
5              
6 176     176   823 use JQ::Lite::Util ();
  176         290  
  176         1983  
7 176     176   554 use JSON::PP ();
  176         269  
  176         264514  
8              
9             sub parse_query {
10 936     936 0 1743 my ($query) = @_;
11              
12 936 50       1766 return () unless defined $query;
13 936 50       2610 return () if $query =~ /^\s*\.\s*$/;
14              
15 936         2399 my @parts = JQ::Lite::Util::_split_top_level_pipes($query);
16             @parts = map {
17 936         1754 my $part = $_;
  1393         1697  
18 1393         6465 $part =~ s/^\s+|\s+$//g;
19 1393         3145 $part;
20             } @parts;
21              
22             @parts = map {
23 936 100       1241 if ($_ eq '.[]') {
  1393 100       4303  
24 14         51 '.[]';
25             }
26             elsif ($_ =~ /^\.(.+)$/) {
27 549         1331 my $rest = $1;
28 549 100 100     6394 if ($rest =~ /,/) {
    100 100        
    100 66        
29 5         10 $_; # preserve leading dot when sequence filters are present
30             }
31             elsif ($rest =~ /^\s*\[/) {
32 4         10 $_; # preserve leading dot for array indexing and bracket access
33             }
34             elsif ($rest =~ /^\s*[+\-*\/%]/
35             || $rest =~ /[+\-*\/%]/
36             || $rest =~ /(?:==|!=|>=|<=|>|<|\band\b|\bor\b)/i
37             || $rest =~ /\b(?:floor|ceil|round|tonumber)\b/)
38             {
39 49         111 $_;
40             }
41             else {
42 491         744 my $trimmed = $rest;
43 491         1326 $trimmed =~ s/^\s+|\s+$//g;
44 491 100       1036 if ($trimmed =~ /^"(?:[^"\\]|\\.)*"$/s) {
45 2         3 my $decoded = eval { JQ::Lite::Util::_decode_json($trimmed) };
  2         4  
46 2 50 33     152 return $decoded if defined $decoded && !$@;
47             }
48 489         967 $rest;
49             }
50             }
51             else {
52 830         1445 $_;
53             }
54             } @parts;
55              
56 934         6265 @parts = map { _lower_object_shorthand($_) } @parts;
  1391         2518  
57              
58 934         1353 my @expanded;
59 934         1496 for my $part (@parts) {
60 1391 50       2151 next unless defined $part;
61              
62 1391         1496 my $trimmed = $part;
63 1391         3796 $trimmed =~ s/^\s+|\s+$//g;
64              
65 1391 100       2840 if ($trimmed =~ /^\(.*\)$/s) {
66 4         11 my $inner = JQ::Lite::Util::_strip_wrapping_parens($trimmed);
67 4 100 33     32 if (defined $inner && length $inner && $inner ne $trimmed) {
      66        
68 3         17 my @inner_parts = parse_query($inner);
69 3 50       5 if (@inner_parts) {
70 3         6 push @expanded, @inner_parts;
71 3         6 next;
72             }
73             }
74             }
75              
76 1388         2216 push @expanded, $trimmed;
77             }
78              
79 934         2353 return @expanded;
80             }
81              
82             sub _lower_object_shorthand {
83 1424     1424   2081 my ($text) = @_;
84              
85 1424 50       2181 return $text unless defined $text;
86 1424 100       3559 return $text if index($text, '{') == -1;
87              
88 28         47 my $result = '';
89 28         35 my $len = length $text;
90 28         37 my $i = 0;
91 28         31 my $string;
92 28         36 my $escape = 0;
93              
94 28         59 while ($i < $len) {
95 266         287 my $char = substr($text, $i, 1);
96              
97 266 100       320 if (defined $string) {
98 32         31 $result .= $char;
99 32 50       58 if ($escape) {
    50          
    100          
100 0         0 $escape = 0;
101             }
102             elsif ($char eq '\\') {
103 0         0 $escape = 1;
104             }
105             elsif ($char eq $string) {
106 4         6 undef $string;
107             }
108 32         28 $i++;
109 32         40 next;
110             }
111              
112 234 100 66     511 if ($char eq "'" || $char eq '"') {
113 4         17 $string = $char;
114 4         6 $result .= $char;
115 4         5 $i++;
116 4         8 next;
117             }
118              
119 230 100       292 if ($char eq '{') {
120 28         66 my ($body, $consumed) = _extract_object_body($text, $i);
121 28 50       60 if (defined $body) {
122 28         102 my $lowered = _lower_object_constructor($body);
123 28         44 $result .= '{' . $lowered . '}';
124 28         83 $i += $consumed;
125 28         56 next;
126             }
127             }
128              
129 202         189 $result .= $char;
130 202         248 $i++;
131             }
132              
133 28         71 return $result;
134             }
135              
136             sub _extract_object_body {
137 28     28   48 my ($text, $start) = @_;
138              
139 28         34 my $len = length $text;
140 28         34 my $depth = 0;
141 28         32 my $string;
142 28         37 my $escape = 0;
143              
144 28         69 for (my $i = $start; $i < $len; $i++) {
145 566         570 my $char = substr($text, $i, 1);
146              
147 566 100       647 if (defined $string) {
148 200 50       240 if ($escape) {
149 0         0 $escape = 0;
150 0         0 next;
151             }
152              
153 200 50       232 if ($char eq '\\') {
154 0         0 $escape = 1;
155 0         0 next;
156             }
157              
158 200 100       244 if ($char eq $string) {
159 37         41 undef $string;
160             }
161              
162 200         228 next;
163             }
164              
165 366 100 66     870 if ($char eq "'" || $char eq '"') {
166 37         43 $string = $char;
167 37         47 next;
168             }
169              
170 329 100       479 if ($char eq '{') {
171 32         53 $depth++;
172 32         63 next;
173             }
174              
175 297 100       435 if ($char eq '}') {
176 32         40 $depth--;
177 32 100       56 if ($depth == 0) {
178 28         62 my $body = substr($text, $start + 1, $i - $start - 1);
179 28         99 return ($body, $i - $start + 1);
180             }
181 4         6 next;
182             }
183             }
184              
185 0         0 return (undef, 1);
186             }
187              
188             sub _lower_object_constructor {
189 28     28   43 my ($inner) = @_;
190              
191 28 50       63 return $inner unless defined $inner;
192              
193 28         73 my @parts = JQ::Lite::Util::_split_top_level_commas($inner);
194 28 50       104 return $inner unless @parts;
195              
196 28         42 my @transformed;
197 28         53 for my $part (@parts) {
198 37 50       83 next unless defined $part;
199              
200 37         52 my $trimmed = $part;
201 37         164 $trimmed =~ s/^\s+|\s+$//g;
202 37 100       73 next if $trimmed eq '';
203              
204 36         96 my ($lhs, $rhs) = JQ::Lite::Util::_split_top_level_colon($part);
205              
206 36 100 66     110 if (defined $lhs && defined $rhs) {
207 33         44 my $key = $lhs;
208 33         165 $key =~ s/^\s+|\s+$//g;
209              
210 33         88 my $value = _lower_object_shorthand($rhs);
211 33         153 $value =~ s/^\s+|\s+$//g;
212              
213 33         66 push @transformed, "$key: $value";
214 33         54 next;
215             }
216              
217 3 50 33     15 if (!defined $lhs && $trimmed =~ /^[A-Za-z_][A-Za-z0-9_]*$/) {
218 3         6 push @transformed, "$trimmed: .$trimmed";
219 3         4 next;
220             }
221              
222 0 0 0     0 if (defined $lhs && !defined $rhs) {
223 0         0 my $key = $lhs;
224 0         0 $key =~ s/^\s+|\s+$//g;
225 0 0       0 next if $key eq '';
226 0         0 push @transformed, "$key: .$key";
227 0         0 next;
228             }
229              
230 0         0 my $lowered = _lower_object_shorthand($trimmed);
231 0         0 $lowered =~ s/^\s+|\s+$//g;
232 0 0       0 push @transformed, $lowered if length $lowered;
233             }
234              
235 28         85 return join(', ', @transformed);
236             }
237              
238             1;