File Coverage

lib/Neo4j/Driver/Result/JSON.pm
Criterion Covered Total %
statement 139 143 97.9
branch 45 56 87.5
condition 48 68 70.5
subroutine 24 24 100.0
pod 0 1 100.0
total 256 292 89.7


line stmt bran cond sub pod time code
1 20     20   266 use v5.14;
  20         77  
2 20     20   117 use warnings;
  20         36  
  20         1797  
3              
4             package Neo4j::Driver::Result::JSON 1.02;
5             # ABSTRACT: JSON/REST result handler
6              
7              
8             # This package is not part of the public Neo4j::Driver API.
9              
10              
11 20     20   166 use parent 'Neo4j::Driver::Result';
  20         69  
  20         165  
12              
13 20     20   2548 use Carp qw(croak);
  20         73  
  20         2242  
14             our @CARP_NOT = qw(Neo4j::Driver::Net::HTTP);
15 20     20   145 use Feature::Compat::Try;
  20         42  
  20         178  
16 20     20   4500 use JSON::MaybeXS 1.002004 ();
  20         518  
  20         717  
17              
18 20     20   119 use Neo4j::Driver::Type::Bytes;
  20         42  
  20         664  
19 20     20   119 use Neo4j::Driver::Type::DateTime;
  20         35  
  20         710  
20 20     20   107 use Neo4j::Driver::Type::Duration;
  20         32  
  20         606  
21 20     20   138 use Neo4j::Driver::Type::Path;
  20         44  
  20         508  
22 20     20   99 use Neo4j::Driver::Type::Point;
  20         32  
  20         550  
23 20     20   102 use Neo4j::Driver::Type::V1::Node;
  20         36  
  20         521  
24 20     20   116 use Neo4j::Driver::Type::V1::Relationship;
  20         39  
  20         607  
25 20     20   106 use Neo4j::Error;
  20         61  
  20         59820  
26              
27              
28             my ($FALSE, $TRUE) = Neo4j::Driver::Result->_bool_values;
29              
30             my $MEDIA_TYPE = "application/json";
31             my $ACCEPT_HEADER = "$MEDIA_TYPE";
32             my $ACCEPT_HEADER_POST = "$MEDIA_TYPE;q=0.5";
33              
34              
35             sub new {
36             # uncoverable pod (private method)
37 185     185 0 696 my ($class, $params) = @_;
38            
39 185         1244 my $json = $class->_parse_json($params);
40            
41 185         441 my @results = ();
42 185 100       679 @results = @{ $json->{results} } if ref $json->{results} eq 'ARRAY';
  107         309  
43 185         468 @results = map { $class->_new_result($_, $json, $params) } @results;
  81         449  
44 185         876 $results[$_]->{query} = $params->{queries}->[$_] for (0 .. $#results);
45            
46 185 100       586 if (@results == 1) {
47 81         222 $results[0]->{json} = $json; # for _info()
48 81         399 return $results[0];
49             }
50            
51             # If the number of Cypher queries run wasn't exactly one, provide
52             # a dummy result containing the raw JSON so that callers can do their
53             # own parsing. Also, provide a list of all results so that callers
54             # get a uniform interface for all of them.
55             return bless {
56             json => $json,
57             attached => 0,
58             exhausted => 1,
59             buffer => [],
60             server_info => $params->{server_info},
61 104 50       1185 result_list => @results ? \@results : undef,
62             }, $class;
63             }
64              
65              
66             sub _new_result {
67 81     81   286 my ($class, $result, $json, $params) = @_;
68            
69             my $self = {
70             attached => 0, # 1: unbuffered records may exist on the stream
71             exhausted => 0, # 1: all records read by the client; fetch() will fail
72             result => $result,
73             buffer => [],
74             field_names_cache => undef,
75             summary => undef,
76             notifications => $json->{notifications},
77             server_info => $params->{server_info},
78 81         1155 };
79 81         232 bless $self, $class;
80            
81 81         710 return $self->_as_fully_buffered;
82             }
83              
84              
85             sub _parse_json {
86 185     185   496 my (undef, $params) = @_;
87            
88 185         910 my $response = $params->{http_agent}->fetch_all;
89 185         2425 my $error = 'Neo4j::Error';
90 185         295 my $json;
91 185         411 try {
92 185         675 $json = $params->{http_agent}->json_coder->decode($response);
93             }
94             catch ($e) {
95 0         0 $error = $error->append_new( Internal => {
96             as_string => "$e",
97             raw => $response,
98             });
99             }
100 185 100       916748 if (ref $json->{errors} eq 'ARRAY') {
101 107         258 $error = $error->append_new( Server => $_ ) for @{$json->{errors}};
  107         451  
102             }
103 185 50       13424 if ($json->{message}) {
104 0         0 $error = $error->append_new( Internal => $json->{message} );
105             # can happen when the Jersey ServletContainer intercepts the request
106             }
107 185 100       709 if (! $params->{http_header}->{success}) {
108             $error = $error->append_new( Network => {
109             code => $params->{http_header}->{status},
110             as_string => sprintf( "HTTP error: %s %s on %s to %s",
111 2         21 $params->{http_header}->{status}, $params->{http_agent}->http_reason, $params->{http_method}, $params->{http_path} ),
112             });
113             }
114            
115 185 100       5402 $json->{_error} = $error if ref $error;
116            
117 185         478 return $json;
118             }
119              
120              
121             # Return the full list of results this object represents.
122             sub _results {
123 98     98   241 my ($self) = @_;
124            
125 98 50       335 return @{ $self->{result_list} } if $self->{result_list};
  0         0  
126 98         571 return ($self);
127             }
128              
129              
130             # Return the raw JSON response (if available).
131             sub _json {
132 76     76   172 my ($self) = @_;
133 76         218 return $self->{json};
134             }
135              
136              
137             # Return transaction status information (if available).
138             sub _info {
139 185     185   415 my ($self) = @_;
140 185         596 return $self->{json};
141             }
142              
143              
144             # Bless and initialise the given reference as a Record.
145             sub _init_record {
146 83     83   221 my ($self, $record) = @_;
147            
148 83         246 $record->{field_names_cache} = $self->{field_names_cache};
149 83         462 $self->_deep_bless( $record->{row}, $record->{meta}, $record->{rest} );
150 83         369 delete $record->{meta};
151 83         1501 delete $record->{rest};
152 83         707 return bless $record, 'Neo4j::Driver::Record';
153             }
154              
155              
156             sub _deep_bless {
157 341     341   730 my ($self, $data, $meta, $rest) = @_;
158            
159             # "meta" is broken, so we primarily use "rest", see neo4j #12306
160            
161 341 100 66     1382 if (ref $data eq 'HASH' && ref $rest eq 'HASH' && ref $rest->{metadata} eq 'HASH' && $rest->{self} && $rest->{self} =~ m|/db/[^/]+/node/|) { # node
      100        
      66        
      66        
162             return bless [
163             $rest->{metadata}->{id},
164 27   50     296 $rest->{metadata}->{labels} // [],
165             $data,
166             ], 'Neo4j::Driver::Type::V1::Node';
167             }
168 314 50 66     931 if (ref $data eq 'HASH' && ref $rest eq 'HASH' && ref $rest->{metadata} eq 'HASH' && $rest->{self} && $rest->{self} =~ m|/db/[^/]+/relationship/|) { # relationship
      100        
      66        
      33        
169             return bless [
170             $rest->{metadata}->{id},
171 11         61 do { $rest->{start} =~ m/(\d+)$/a; 0 + $1 },
  11         41  
172             $rest->{metadata}->{type},
173 11         29 do { $rest->{end} =~ m/(\d+)$/a; 0 + $1 },
  11         47  
  11         68  
174             $data,
175             ], 'Neo4j::Driver::Type::V1::Relationship';
176             }
177            
178 303 100 100     958 if (ref $data eq 'ARRAY' && ref $rest eq 'HASH') { # path
179 8 50       40 die "Assertion failed: path length mismatch: ".(scalar @$data).">>1/$rest->{length}" if @$data >> 1 != $rest->{length}; # uncoverable branch true
180 8         26 my $path = [];
181 8         17 for my $n ( 0 .. $#{ $rest->{nodes} } ) {
  8         29  
182 19         39 my $i = $n * 2;
183             $path->[$i] = bless [
184 19         27 do { $rest->{nodes}->[$n] =~ m/(\d+)$/a; 0 + $1 },
  19         123  
  19         95  
185             [], # see neo4j#12613
186             $data->[$i],
187             ], 'Neo4j::Driver::Type::V1::Node';
188             }
189 8         18 for my $r ( 0 .. $#{ $rest->{relationships} } ) {
  8         27  
190 11         50 my $i = $r * 2 + 1;
191 11 100       38 my $dir = $rest->{directions}->[$r] eq '->' ? 1 : -1;
192             $path->[$i] = bless [
193 11         20 do { $rest->{relationships}->[$r] =~ m/(\d+)$/a; 0 + $1 },
  11         55  
  11         112  
194             $path->[$i - 1 * $dir]->[0],
195             undef, # see neo4j#12613
196             $path->[$i + 1 * $dir]->[0],
197             $data->[$i],
198             ], 'Neo4j::Driver::Type::V1::Relationship';
199             }
200 8         118 return bless { '..' => $path }, 'Neo4j::Driver::Type::Path';
201             }
202            
203 295 100 66     727 if (ref $data eq 'HASH' && ref $rest eq 'HASH' && ref $rest->{crs} eq 'HASH') { # spatial
      100        
204 1         2 $rest->{srid} = $rest->{crs}->{srid};
205 1         8 return bless $rest, 'Neo4j::Driver::Type::Point';
206             }
207 294 50 66     1167 if (ref $data eq '' && ref $rest eq '' && ref $meta eq 'HASH' && $meta->{type} && $meta->{type} =~ m/date|time|duration/) { # temporal (depends on meta => doesn't always work)
      100        
      66        
      33        
208 2 100       16 return bless { T => $data }, $meta->{type} eq 'duration'
209             ? 'Neo4j::Driver::Type::Duration'
210             : 'Neo4j::Driver::Type::DateTime';
211             }
212            
213 292 100 66     936 if (ref $data eq 'ARRAY' && ref $rest eq 'ARRAY') { # array
214 95 50       328 die "Assertion failed: array rest size mismatch" if @$data != @$rest; # uncoverable branch true
215 95 100 100     511 $meta = [] if ref $meta ne 'ARRAY' || @$data != @$meta; # handle neo4j #12306
216 95         191 foreach my $i ( 0 .. $#{$data} ) {
  95         305  
217 247         945 $data->[$i] = $self->_deep_bless( $data->[$i], $meta->[$i], $rest->[$i] );
218             }
219 95         249 return $data;
220             }
221 197 100 66     464 if (ref $data eq 'HASH' && ref $rest eq 'HASH') { # and neither node nor relationship nor spatial ==> map
222 8 50       25 die "Assertion failed: map rest size mismatch" if (scalar keys %$data) != (scalar keys %$rest); # uncoverable branch true
223 8 50       61 die "Assertion failed: map rest keys mismatch" if (join '', sort keys %$data) ne (join '', sort keys %$rest); # uncoverable branch true
224 8 50 33     32 $meta = {} if ref $meta ne 'HASH' || (scalar keys %$data) != (scalar keys %$meta); # handle neo4j #12306
225 8         21 foreach my $key ( keys %$data ) {
226 11         62 $data->{$key} = $self->_deep_bless( $data->{$key}, $meta->{$key}, $rest->{$key} );
227             }
228 8         35 return $data;
229             }
230            
231 189 100 66     758 if (JSON::MaybeXS::is_bool($data) && JSON::MaybeXS::is_bool($rest)) { # boolean
232 13 100       305 return $data ? $TRUE : $FALSE;
233             }
234 176 50 33     2264 if (ref $data eq '' && ref $rest eq '') { # scalar
235 176         537 return $data;
236             }
237            
238 0         0 die "Assertion failed: unexpected type combo: " . ref($data) . "/" . ref($rest); # uncoverable statement
239             }
240              
241              
242             # Return a list of the media types this module can handle, fit for
243             # use in an HTTP Accept header field.
244             sub _accept_header {
245 214     214   485 my (undef, $want_jolt, $method) = @_;
246            
247             # 'v1' is used as an internal marker for Neo4j 4
248             # Note: Neo4j < 4.2 doesn't fail gracefully if Jolt is the only acceptable response type.
249 214 100 100     684 return if $want_jolt && $want_jolt ne 'v1';
250            
251 202 100       713 return ($ACCEPT_HEADER_POST) if $method eq 'POST';
252 82         363 return ($ACCEPT_HEADER);
253             }
254              
255              
256             # Whether the given media type can be handled by this module.
257             sub _acceptable {
258 124     124   280 my (undef, $content_type) = @_;
259            
260 124         1380 return $content_type =~ m/^$MEDIA_TYPE\b/i;
261             }
262              
263              
264             1;