File Coverage

blib/lib/JSON/Path/Tokenizer.pm
Criterion Covered Total %
statement 94 94 100.0
branch 51 52 98.0
condition 16 21 76.1
subroutine 11 11 100.0
pod 0 1 0.0
total 172 179 96.0


line stmt bran cond sub pod time code
1             package JSON::Path::Tokenizer;
2             $JSON::Path::Tokenizer::VERSION = '1.0.6';
3 21     21   249217 use strict;
  21         47  
  21         866  
4 21     21   157 use warnings;
  21         36  
  21         1498  
5              
6 21     21   129 use Carp;
  21         35  
  21         1770  
7 21     21   539 use Readonly;
  21         3472  
  21         1059  
8 21     21   493 use JSON::Path::Constants qw(:symbols :operators);
  21         44  
  21         154  
9 21     21   151531 use Exporter::Shiny 'tokenize';
  21         44  
  21         198  
10              
11             Readonly my $ESCAPE_CHAR => qq{\\};
12             Readonly my %OPERATORS => (
13             $TOKEN_ROOT => 1, # $
14             $TOKEN_RECURSIVE => 1, # ..
15             $TOKEN_CHILD => 1, # .
16             $TOKEN_FILTER_OPEN => 1, # [?(
17             $TOKEN_FILTER_SCRIPT_CLOSE => 1, # )]
18             $TOKEN_SCRIPT_OPEN => 1, # [(
19             $TOKEN_SUBSCRIPT_OPEN => 1, # [
20             $TOKEN_SUBSCRIPT_CLOSE => 1, # ]
21             $TOKEN_QUOTE => 1, # "
22             );
23              
24             # my $invocation = 0;
25              
26             # ABSTRACT: Helper class for JSON::Path::Evaluator. Do not call directly.
27              
28             # Take an expression and break it up into tokens
29             sub tokenize {
30 304     304 0 240397 my $expression = shift;
31             #print "Tokenize \"$expression\"\n";
32 304         3597 my $chars = [ split //, $expression ];
33              
34 304         1003 my @tokens;
35 304         919 while ( defined( my $token = _read_to_next_token($chars) ) ) {
36              
37             # print "$invocation: Got token: $token\n";
38 1686         3466 push @tokens, $token;
39 1686 100 100     3695 if ( $token eq $TOKEN_SCRIPT_OPEN || $token eq $TOKEN_FILTER_OPEN ) {
40              
41             # print "$invocation: script/filter open: $token\n";
42 72         769 push @tokens, _read_to_filter_script_close($chars);
43             }
44             }
45 304         2023 return @tokens;
46             }
47              
48             sub _read_to_filter_script_close {
49 72     72   129 my $chars = shift;
50              
51 72         3934 my %escaped_chars = (
52             "b" => "\x{0008}",
53             "f" => "\x{000C}",
54             "n" => "\x{000A}",
55             "r" => "\x{000D}",
56             "t" => "\x{0009}",
57             "v" => "\x{000B}",
58             "0" => "\x{0000}",
59             "'" => "\x{0027}",
60             '"' => "\x{0022}",
61             "\\" => "\x{005C}",
62             );
63              
64             #print "$invocation: read to filter script close: " . join( '', @{$chars} ) . "\n";
65 72         256 my $filter;
66             my $in_regex;
67 72         0 my $in_quote;
68 72         155 my $escape = 0;
69              
70 72         202 my @quote_chars = ($APOSTROPHE, $QUOTATION_MARK);
71 72         736 my @regex_chars = "/";
72              
73 72         126 while ( defined( my $char = shift @{$chars} ) ) {
  1934         10432  
74 1934 100       4073 if ( $in_quote ) {
    100          
    100          
    100          
75 265 100       663 if ( $escape ) {
    100          
    100          
76             ## Replace \t by tab, \\ by \, etc
77 3   33     9 $char = $escaped_chars{$char} || $char;
78 3         5 $escape = 0;
79             }
80             elsif ( $char eq "\\" ) {
81             ## Don't include \ and flag so next char in sequence
82             ## is replaced correctly.
83 3         5 $escape = 1;
84 3         7 next;
85             }
86             elsif ( $char eq $in_quote ) {
87 24         49 $in_quote = '';
88             }
89             }
90             elsif ( $in_regex ) {
91 225 100       470 if ( $escape ) {
    100          
    100          
92 25         29 $escape = 0;
93             }
94             elsif ( $char eq "\\" ) {
95 25         35 $escape = 1;
96             }
97             elsif ( $char eq $in_regex ) {
98 19         31 $in_regex = '';
99             }
100             }
101 2888         8541 elsif (grep { $_ eq $char } @quote_chars) {
102 24         52 $in_quote = $char;
103             }
104 1420         2958 elsif (grep { $_ eq $char } @regex_chars) {
105 19         34 $in_regex = $char;
106             }
107              
108 1931         2765 $filter .= $char;
109              
110 1931 50       2370 last unless @{$chars};
  1931         3347  
111 1931 100 100     3947 last if $chars->[0] eq $RIGHT_PARENTHESIS && !$in_quote && !$in_regex;
      100        
112             }
113 72         1159 return $filter;
114             }
115              
116             sub _read_to_next_token {
117             #$invocation++;
118 1990     1990   23247 my $chars = shift;
119              
120             #print "$invocation: Get next token: " . join( '', @{$chars} ) . "\n";
121 1990         3050 my $in_quote = '';
122 1990         2901 my $token;
123 1990         2904 while ( defined( my $char = shift @{$chars} ) ) {
  4413         22257  
124              
125 4109 100 66     9296 if ( $char eq $APOSTROPHE || $char eq $QUOTATION_MARK ) {
126             #print "$invocation: Char is $APOSTROPHE or $QUOTATION_MARK. Char: $char, in_quote: $in_quote\n";
127 48 100 66     271 if ( $in_quote && $in_quote eq $char ) {
128 24         33 $in_quote = '';
129 24         33 last;
130             }
131 24         34 $in_quote = $char;
132              
133             #print "$invocation: Set \$in_quote to $in_quote\n";
134 24         30 next;
135             }
136              
137 4061 100 66     41070 if ( $char eq $ESCAPE_CHAR && !$in_quote ) {
138              
139             #print "$invocation: Got escape char: $char\n";
140 2         17 $token .= shift @{$chars};
  2         6  
141 2         7 next;
142             }
143              
144             #print "Append '$char' to token '$token'\n";
145 4059         21093 $token .= $char;
146 4059 100       7488 next if $in_quote;
147              
148             # Break out of the loop if the current character is the last one in the stream.
149 3958 100       5268 last unless @{$chars};
  3958         7640  
150              
151 3693 100       7779 if ( $char eq $LEFT_SQUARE_BRACKET )
    100          
    100          
152             { # distinguish between '[', '[(', and '[?('
153 182 100       1031 if ( $chars->[0] eq $LEFT_PARENTHESIS ) {
154 1         8 next;
155             }
156 181 100       1201 if ( $chars->[0] eq $QUESTION_MARK ) {
157              
158             # The below appends the '?'. The '(' will be appended in the next iteration of the loop
159 71         397 $token .= shift @{$chars};
  71         157  
160 71         209 next;
161             }
162             }
163             elsif ( $char eq $RIGHT_PARENTHESIS ) {
164              
165             #print "$invocation: Found right parenthesis\n";
166              
167             # A right parenthesis should be followed by a right square bracket, which itself is a token.
168             # Append the next character and proceed.
169 72         651 $token .= shift @{$chars};
  72         210  
170              
171             #print "$invocation: Token is now: $token\n";
172             }
173             elsif ( $char eq $FULL_STOP ) {
174              
175             # A full stop (i.e. a period, '.') may be the child operator '.' or the recursive operator '..'
176 458 100       5903 $token .= shift @{$chars} if $chars->[0] eq $FULL_STOP;
  17         103  
177             }
178              
179             # If we've assembled an operator, we're done.
180 3621 100       44691 last if $OPERATORS{$token};
181              
182             # Similarly, if the next character is an operator, we're done
183 2665 100       20505 last if $OPERATORS{ $chars->[0] };
184             }
185 21     21   18116 no warnings qw/uninitialized/;
  21         42  
  21         1740  
186              
187             #print "$invocation: Token: $token\n";
188 21     21   125 use warnings qw/uninitialized/;
  21         45  
  21         2525  
189 1990         13496 return $token;
190             }
191              
192             1;
193              
194             __END__