File Coverage

lib/Neo4j/Driver/Result/JSON.pm
Criterion Covered Total %
statement 139 148 94.5
branch 55 72 81.9
condition 47 72 65.2
subroutine 20 21 95.2
pod 0 1 100.0
total 261 314 85.0


line stmt bran cond sub pod time code
1 17     17   318 use 5.010;
  17         57  
2 17     17   92 use strict;
  17         34  
  17         369  
3 17     17   96 use warnings;
  17         37  
  17         483  
4 17     17   95 use utf8;
  17         48  
  17         100  
5              
6             package Neo4j::Driver::Result::JSON;
7             # ABSTRACT: JSON/REST result handler
8             $Neo4j::Driver::Result::JSON::VERSION = '0.40';
9              
10             # This package is not part of the public Neo4j::Driver API.
11              
12              
13 17     17   1011 use parent 'Neo4j::Driver::Result';
  17         43  
  17         101  
14              
15 17     17   1481 use Carp qw(carp croak);
  17         72  
  17         1533  
16             our @CARP_NOT = qw(Neo4j::Driver::Net::HTTP);
17 17     17   137 use Try::Tiny;
  17         40  
  17         1133  
18              
19 17     17   188 use URI 1.31;
  17         338  
  17         828  
20              
21 17     17   102 use Neo4j::Error;
  17         39  
  17         36871  
22              
23              
24             my ($TRUE, $FALSE);
25              
26             my $MEDIA_TYPE = "application/json";
27             my $ACCEPT_HEADER = "$MEDIA_TYPE";
28             my $ACCEPT_HEADER_POST = "$MEDIA_TYPE;q=0.5";
29              
30              
31             sub new {
32             # uncoverable pod (private method)
33 202     202 0 474 my ($class, $params) = @_;
34            
35 202 100       1417 ($TRUE, $FALSE) = @{ $params->{http_agent}->json_coder->decode('[true,false]') } unless $TRUE;
  15         83  
36            
37 202         4826 my $json = $class->_parse_json($params);
38            
39 202         365 my @results = ();
40 202 100       516 @results = @{ $json->{results} } if ref $json->{results} eq 'ARRAY';
  130         296  
41 202         361 @results = map { $class->_new_result($_, $json, $params) } @results;
  105         357  
42 202         752 $results[$_]->{statement} = $params->{statements}->[$_] for (0 .. $#results);
43            
44 202 100       525 if (@results == 1) {
45 100         216 $results[0]->{json} = $json; # for _info()
46 100         305 return $results[0];
47             }
48            
49             # If the number of Cypher statements run wasn't exactly one, provide
50             # a dummy result containing the raw JSON so that callers can do their
51             # own parsing. Also, provide a list of all results so that callers
52             # get a uniform interface for all of them.
53             return bless {
54             json => $json,
55             attached => 0,
56             exhausted => 1,
57             buffer => [],
58             server_info => $params->{server_info},
59 102 100       786 result_list => @results ? \@results : undef,
60             }, $class;
61             }
62              
63              
64             sub _new_result {
65 105     105   284 my ($class, $result, $json, $params) = @_;
66            
67             my $self = {
68             attached => 0, # 1: unbuffered records may exist on the stream
69             exhausted => 0, # 1: all records read by the client; fetch() will fail
70             result => $result,
71             buffer => [],
72             columns => undef,
73             summary => undef,
74             cypher_types => $params->{cypher_types},
75             notifications => $json->{notifications},
76             server_info => $params->{server_info},
77 105         801 };
78 105         233 bless $self, $class;
79            
80 105         458 return $self->_as_fully_buffered;
81             }
82              
83              
84             sub _parse_json {
85 202     202   379 my (undef, $params) = @_;
86            
87 202         681 my $response = $params->{http_agent}->fetch_all;
88 202         1797 my $error = 'Neo4j::Error';
89 202         247 my $json;
90             try {
91 202     202   13241 $json = $params->{http_agent}->json_coder->decode($response);
92             }
93             catch {
94 0     0   0 $error = $error->append_new( Internal => {
95             as_string => "$_",
96             raw => $response,
97             });
98 202         1497 };
99 202 100       905561 if (ref $json->{errors} eq 'ARRAY') {
100 130         239 $error = $error->append_new( Server => $_ ) for @{$json->{errors}};
  130         451  
101             }
102 202 50       17816 if ($json->{message}) {
103 0         0 $error = $error->append_new( Internal => $json->{message} );
104             # can happen when the Jersey ServletContainer intercepts the request
105             }
106 202 100       533 if (! $params->{http_header}->{success}) {
107             $error = $error->append_new( Network => {
108             code => $params->{http_header}->{status},
109             as_string => sprintf( "HTTP error: %s %s on %s to %s",
110 2         14 $params->{http_header}->{status}, $params->{http_agent}->http_reason, $params->{http_method}, $params->{http_path} ),
111             });
112             }
113            
114 202 100       3778 $json->{_error} = $error if ref $error;
115            
116 202         428 return $json;
117             }
118              
119              
120             # Return the full list of results this object represents.
121             sub _results {
122 117     117   262 my ($self) = @_;
123            
124 117 100       278 return @{ $self->{result_list} } if $self->{result_list};
  2         9  
125 115         451 return ($self);
126             }
127              
128              
129             # Return the raw JSON response (if available).
130             sub _json {
131 70     70   159 my ($self) = @_;
132 70         147 return $self->{json};
133             }
134              
135              
136             # Return transaction status information (if available).
137             sub _info {
138 202     202   411 my ($self) = @_;
139 202         540 return $self->{json};
140             }
141              
142              
143             # Bless and initialise the given reference as a Record.
144             sub _init_record {
145 99     99   211 my ($self, $record) = @_;
146            
147 99         227 $record->{column_keys} = $self->{columns};
148 99         338 $self->_deep_bless( $record->{row}, $record->{meta}, $record->{rest} );
149 99         455 return bless $record, 'Neo4j::Driver::Record';
150             }
151              
152              
153             sub _deep_bless {
154 403     403   751 my ($self, $data, $meta, $rest) = @_;
155 403         490 my $cypher_types = $self->{cypher_types};
156            
157             # "meta" is broken, so we primarily use "rest", see neo4j #12306
158            
159 403 100 66     1272 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        
160 32         129 my $node = bless \$data, $cypher_types->{node};
161 32         63 $data->{_meta} = $rest->{metadata};
162 32 100       81 $data->{_meta}->{deleted} = $meta->{deleted} if ref $meta eq 'HASH';
163 32 100       66 $cypher_types->{init}->($node) if $cypher_types->{init};
164 32         85 return $node;
165             }
166 371 50 66     1629 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        
167 12         45 my $rel = bless \$data, $cypher_types->{relationship};
168 12         29 $data->{_meta} = $rest->{metadata};
169 12         60 $rest->{start} =~ m|/([0-9]+)$|;
170 12         47 $data->{_meta}->{start} = 0 + $1;
171 12         45 $rest->{end} =~ m|/([0-9]+)$|;
172 12         37 $data->{_meta}->{end} = 0 + $1;
173 12 100       64 $data->{_meta}->{deleted} = $meta->{deleted} if ref $meta eq 'HASH';
174 12 50       32 $cypher_types->{init}->($rel) if $cypher_types->{init};
175 12         30 return $rel;
176             }
177            
178 359 100 100     901 if (ref $data eq 'ARRAY' && ref $rest eq 'HASH') { # path
179 10 50       56 die "Assertion failed: path length mismatch: ".(scalar @$data).">>1/$rest->{length}" if @$data >> 1 != $rest->{length}; # uncoverable branch true
180 10         34 my $path = [];
181 10         13 for my $n ( 0 .. $#{ $rest->{nodes} } ) {
  10         30  
182 23         46 my $i = $n * 2;
183 23         33 my $uri = $rest->{nodes}->[$n];
184 23         96 $uri =~ m|/([0-9]+)$|;
185 23         97 $data->[$i]->{_meta} = { id => 0 + $1 };
186 23 100       65 $data->[$i]->{_meta}->{deleted} = $meta->[$i]->{deleted} if ref $meta eq 'ARRAY';
187 23         70 $path->[$i] = bless \( $data->[$i] ), $cypher_types->{node};
188             }
189 10         24 for my $r ( 0 .. $#{ $rest->{relationships} } ) {
  10         27  
190 13         25 my $i = $r * 2 + 1;
191 13         22 my $uri = $rest->{relationships}->[$r];
192 13         54 $uri =~ m|/([0-9]+)$|;
193 13         55 $data->[$i]->{_meta} = { id => 0 + $1 };
194 13 100       35 my $rev = $rest->{directions}->[$r] eq '<-' ? -1 : 1;
195 13         45 $data->[$i]->{_meta}->{start} = $data->[$i - 1 * $rev]->{_meta}->{id};
196 13         55 $data->[$i]->{_meta}->{end} = $data->[$i + 1 * $rev]->{_meta}->{id};
197 13 100       53 $data->[$i]->{_meta}->{deleted} = $meta->[$i]->{deleted} if ref $meta eq 'ARRAY';
198 13         49 $path->[$i] = bless \( $data->[$i] ), $cypher_types->{relationship};
199             }
200 10         82 $path = bless { path => $path }, $cypher_types->{path};
201 10 50       40 $cypher_types->{init}->($_) for $cypher_types->{init} ? ( @$path, $path ) : ();
202 10         45 return $path;
203             }
204            
205 349 50 66     669 if (ref $data eq 'HASH' && ref $rest eq 'HASH' && ref $rest->{crs} eq 'HASH') { # spatial
      66        
206 0         0 bless $rest, $cypher_types->{point};
207 0 0       0 $cypher_types->{init}->($data) if $cypher_types->{init};
208 0         0 return $rest;
209             }
210 349 0 66     1194 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)
      66        
      33        
      0        
211 0         0 $data = bless { data => $data, type => $meta->{type} }, $cypher_types->{temporal};
212 0 0       0 $cypher_types->{init}->($data) if $cypher_types->{init};
213 0         0 return $data;
214             }
215            
216 349 100 66     777 if (ref $data eq 'ARRAY' && ref $rest eq 'ARRAY') { # array
217 111 50       246 die "Assertion failed: array rest size mismatch" if @$data != @$rest; # uncoverable branch true
218 111 100 100     404 $meta = [] if ref $meta ne 'ARRAY' || @$data != @$meta; # handle neo4j #12306
219 111         154 foreach my $i ( 0 .. $#{$data} ) {
  111         295  
220 293         962 $data->[$i] = $self->_deep_bless( $data->[$i], $meta->[$i], $rest->[$i] );
221             }
222 111         224 return $data;
223             }
224 238 100 66     503 if (ref $data eq 'HASH' && ref $rest eq 'HASH') { # and neither node nor relationship nor spatial ==> map
225 8 50       39 die "Assertion failed: map rest size mismatch" if (scalar keys %$data) != (scalar keys %$rest); # uncoverable branch true
226 8 50       63 die "Assertion failed: map rest keys mismatch" if (join '', sort keys %$data) ne (join '', sort keys %$rest); # uncoverable branch true
227 8 50 33     27 $meta = {} if ref $meta ne 'HASH' || (scalar keys %$data) != (scalar keys %$meta); # handle neo4j #12306
228 8         19 foreach my $key ( keys %$data ) {
229 11         42 $data->{$key} = $self->_deep_bless( $data->{$key}, $meta->{$key}, $rest->{$key} );
230             }
231 8         52 return $data;
232             }
233            
234 230 100 66     744 if (ref $data eq '' && ref $rest eq '') { # scalar
235 217         535 return $data;
236             }
237 13 50 66     38 if ( $data == $TRUE && $rest == $TRUE || $data == $FALSE && $rest == $FALSE ) { # boolean
      33        
      66        
238 13         225 return $data;
239             }
240            
241 0         0 die "Assertion failed: unexpected type combo: " . ref($data) . "/" . ref($rest); # uncoverable statement
242             }
243              
244              
245             # Return a list of the media types this module can handle, fit for
246             # use in an HTTP Accept header field.
247             sub _accept_header {
248 209     209   410 my (undef, $want_jolt, $method) = @_;
249            
250             # 'v1' is used as an internal marker for Neo4j 4
251             # Note: Neo4j < 4.2 doesn't fail gracefully if Jolt is the only acceptable response type.
252 209 100 100     578 return if $want_jolt && $want_jolt ne 'v1';
253            
254 197 100       643 return ($ACCEPT_HEADER_POST) if $method eq 'POST';
255 78         271 return ($ACCEPT_HEADER);
256             }
257              
258              
259             # Whether the given media type can be handled by this module.
260             sub _acceptable {
261 129     129   267 my (undef, $content_type) = @_;
262            
263 129         829 return $content_type =~ m/^$MEDIA_TYPE\b/i;
264             }
265              
266              
267             1;