File Coverage

blib/lib/REST/Neo4p/Agent.pm
Criterion Covered Total %
statement 44 201 21.8
branch 2 82 2.4
condition 2 29 6.9
subroutine 12 30 40.0
pod 13 15 86.6
total 73 357 20.4


line stmt bran cond sub pod time code
1 36     36   470 use v5.10;
  36         128  
2             package REST::Neo4p::Agent;
3 36     36   13957 use REST::Neo4p::Exceptions;
  36         118  
  36         1174  
4 36     36   291 use JSON;
  36         108  
  36         293  
5 36     36   33947 use File::Temp;
  36         352955  
  36         2826  
6 36     36   289 use Carp qw(croak carp);
  36         76  
  36         1692  
7 36     36   279 use strict;
  36         76  
  36         714  
8 36     36   184 use warnings;
  36         61  
  36         1920  
9              
10             our @ISA;
11             our $VERSION;
12             BEGIN {
13 36     36   60973 $REST::Neo4p::Agent::VERSION = '0.4000';
14             }
15              
16             our $AUTOLOAD;
17             our $JOB_CHUNK = 1024;
18             our $JSON = JSON->new()->allow_nonref(1)->utf8;
19             our $RQ_RETRIES = 3;
20             our $RETRY_WAIT = 5;
21             sub new {
22 4     4 1 147 my $class = shift;
23 4         36 my %args = @_;
24 4   100     47 my $mod = delete $args{agent_module} || 'LWP::UserAgent';
25 4 50       27 die "No user agent module specified" unless $mod;
26 4         26 $mod = join('::','REST::Neo4p::Agent',$mod);
27 4 50       416 eval "require $mod;1" or REST::Neo4p::LocalException->throw("Module $mod is not available\n");
28 4         48 my @args = %args;
29 4         40 my $self = $mod->new(@args);
30 4         42 $self->agent("Neo4p/$VERSION");
31 4         272 $self->default_header( 'Accept' => 'application/json' );
32 4         198 $self->default_header( 'Content-Type' => 'application/json' );
33 4         212 $self->default_header( 'X-Stream' => 'true' );
34 4         397 $self->protocols_allowed( ['http','https'] );
35 4         136 return $self;
36             }
37              
38             sub server_url {
39 0     0 1   my $self = shift;
40 0 0         $self->{__server} = shift if @_;
41 0           return $self->{__server};
42             }
43              
44             sub batch_mode {
45 0     0 1   my $self = shift;
46 0 0         $self->{__batch_mode} = shift if @_;
47 0           return $self->{__batch_mode};
48             }
49              
50             sub batch_length{
51 0     0 1   my $self = shift;
52 0 0         REST::Neo4p::LocalException->throw("Agent not in batch mode\n") unless $self->batch_mode;
53             $self->{__batch_length}
54 0           }
55              
56             sub connect {
57              
58 0     0 0   my $self = shift;
59 0           my ($server) = @_;
60 0 0         $self->{__server} = $server if defined $server;
61 0 0         unless ($self->server_url) {
62 0           REST::Neo4p::Exception->throw("Server not set\n");
63             }
64 0           my $resp = $self->get($self->server_url);
65 0 0         unless ($resp->is_success) {
66 0 0         my $exc = $resp->code == 401 ? 'AuthException' : 'CommException';
67 0           "REST::Neo4p::$exc"->throw( code => $resp->code,
68             message => $resp->message );
69             }
70 0           my $json = $JSON->decode($resp->content);
71             # add the discovered URLs to the object hash, keyed by
72             # underscore + :
73 0           foreach (keys %{$json}) {
  0            
74 0 0         next if /^extensions$/;
75             # strip any trailing slash
76 0           $json->{$_} =~ s|/+$||;
77 0           $self->{_actions}{$_} = $json->{$_};
78             }
79 0           $resp = $self->get($self->{_actions}{data});
80 0 0         unless ($resp->is_success) {
81 0 0         my $exc = $resp->code == 401 ? 'AuthException' : 'CommException';
82 0           "REST::Neo4p::$exc"->throw( code => $resp->code,
83             message => $resp->message." (connect phase 2)\n" );
84             }
85 0           $json = $JSON->decode($resp->content);
86 0           foreach (keys %{$json}) {
  0            
87 0 0         next if /^extensions$/;
88 0           $self->{_actions}{$_} = $json->{$_};
89             }
90             # fix for incomplete discovery (relationship endpoint)
91 0 0         unless ($json->{relationship}) {
92 0           $self->{_actions}{relationship} = $self->{_actions}{node};
93 0           $self->{_actions}{relationship} =~ s/node/relationship/;
94             }
95              
96 0           return 1;
97             }
98              
99             # _add_to_batch_queue
100             # takes a request and converts to a Neo4j REST batch-friendly
101             # hash
102             # $url : rest endpoint that would be called ordinarily
103             # $rq : [get|delete|post|put]
104             # $content : hashref of rq content (post and put)
105             # $headers : hashref of additional headers
106             sub _add_to_batch_queue {
107 0     0     my $self = shift;
108 0           my ($url, $rq, $content, $headers) = @_;
109 0           my $data = $self->data;
110 0           $url =~ s|$data||; # get suffix
111 0   0       my $id = ++($self->{__batch_length}||=$self->{__batch_length});
112 0           my $job = {
113             method => uc $rq,
114             to => $url,
115             id => $id
116             };
117 0 0         $job->{body} = $content if defined $content;
118 0           push @{$self->{__batch_queue}}, $job;
  0            
119 0           $self->{_decoded_content} = "{$id}"; # Neo4j batch reference for this job
120 0           return "{$id}";
121             }
122              
123             sub execute_batch {
124 0     0 1   my $self = shift;
125 0           my ($chunk_size) = @_;
126 0 0         unless ($self->batch_mode) {
127 0           REST::Neo4p::LocalException->throw("Agent not in batch mode; can't execute batch\n");
128             }
129 0 0         return unless ($self->batch_length);
130 0           my $tfh = File::Temp->new;
131 0           $self->batch_mode(0);
132 0           my @chunk;
133 0 0         if ($chunk_size) {
134 0           @chunk = splice @{$self->{__batch_queue}}, 0, $chunk_size;
  0            
135 0           $self->{__batch_length} -= @chunk;
136             }
137             else {
138 0           @chunk = @{$self->{__batch_queue}};
  0            
139 0           undef $self->{__batch_queue};
140 0           $self->{__batch_length} = 0;
141             }
142 0           $self->post_batch([],\@chunk, {':content_file' => $tfh->filename});
143 0           $self->batch_mode(1);
144 0           return $tfh;
145             }
146              
147 0     0 1   sub execute_batch_chunk { shift->execute_batch($JOB_CHUNK) }
148              
149 0     0 1   sub raw_response { shift->{_raw_response} }
150             # contains a reference to the returned content, as decoded by JSON
151 0     0 1   sub decoded_content { shift->{_decoded_content} }
152             # contains the url representation of the node returned in the Location:
153             # header
154 0     0 1   sub location { shift->{_location} }
155              
156 0     0 1   sub available_actions { keys %{shift->{_actions}} }
  0            
157              
158 0     0 1   sub no_stream { shift->remove_header('X-Stream') }
159 0     0 1   sub stream { shift->add_header('X-Stream' => 'true') }
160              
161             # autoload getters for discovered neo4j rest urls
162             # when the agent module is Neo4j::Driver, all actions are explicitly defined,
163             # so any call falling through to AUTOLOAD is an error
164              
165             sub AUTOLOAD {
166 0     0     my $self = shift;
167 0           my $method = $AUTOLOAD;
168 0           $method =~ s/.*:://;
169 0 0         if ($self->isa('REST::Neo4p::Agent::Neo4j::Driver')) {
170             # an error
171 0           REST::Neo4p::LocalException->throw( "REST::Neo4p::Agent::Neo4j::Driver does not define method '$method'\n" );
172             }
173 0           my ($rq, $action) = $method =~ /^(get_|post_|put_|delete_)*(.*)$/;
174 0 0         unless (grep /^$action$/,keys %{$self->{_actions}}) {
  0            
175 0           REST::Neo4p::LocalException->throw( __PACKAGE__." does not define method '$method'\n" );
176             }
177 0 0         return $self->{_actions}{$action} unless $rq;
178 0           $rq =~ s/_$//;
179 0           for (my $i = $RQ_RETRIES; $i>0; $i--) {
180 0           eval {
181 0           $self->__do_request($rq, $action, @_);
182             };
183 0 0         if (my $e = REST::Neo4p::CommException->caught()) {
    0          
184 0 0         if ($i > 1) {
185 0           sleep $RETRY_WAIT;
186             }
187             else {
188 0           $e->{message} .= "(after $RQ_RETRIES retries)"; # evil.
189 0           $e->rethrow;
190             }
191             }
192             elsif ($e = Exception::Class->caught()) {
193 0 0 0       (ref $e && $e->can("rethrow")) ? $e->rethrow : die $e;
194             }
195             else {
196 0           last; # success
197             }
198             }
199 0           return $self->{_decoded_content};
200             }
201              
202             # $rq : [get|post|put|delete]
203             # $action : {neo4j REST endpt action}
204             # @args : depends on REST rq
205             # get|delete : my @url_components = @args;
206             # post|put : my ($url_components, $content, $addl_headers) = @args;
207              
208             sub __do_request {
209 0     0     my $self = shift;
210 0           my ($rq, $action, @args) = @_;
211 36     36   18566 use experimental qw/smartmatch/;
  36         49267  
  36         202  
212 0           $self->{_errmsg} = $self->{_location} = $self->{_raw_response} = $self->{_decoded_content} = undef;
213 0           my $resp;
214 0           given ($rq) {
215 0           when (/get|delete/) {
216 0           my @url_components = @args;
217 0           my %rest_params = ();
218             # look for a hashref as final arg containing field => value pairs
219 0 0 0       if (@url_components && ref $url_components[-1] && (ref $url_components[-1] eq 'HASH')) {
      0        
220 0           %rest_params = %{ pop @url_components };
  0            
221             }
222 0           my $url = join('/',$self->{_actions}{$action},@url_components);
223 0           my @params;
224 0           while (my ($p,$v) = each %rest_params) {
225 0           push @params, join('=',$p,$v);
226             }
227 0 0         $url.='?'.join('&',@params) if @params;
228 0 0         if ($self->batch_mode) {
229 0 0 0       $url = (@url_components && ($url_components[0] =~ /{[0-9]+}/)) ? $url_components[0] : $url; # index batch object kludge
230              
231 0           @_ = ($self,
232             $url,
233             $rq);
234 0           goto &_add_to_batch_queue; # short circuit to _add_to_batch_queue
235             }
236             # request made here:
237 0           $resp = $self->{_raw_response} = $self->$rq($url);
238             }
239 0           when (/post|put/) {
240 0           my ($url_components, $content, $addl_headers) = @args;
241 0 0 0       unless (!$addl_headers || (ref $addl_headers eq 'HASH')) {
242 0           REST::Neo4p::LocalException->throw("Arg 3 must be a hashref of additional headers\n");
243             }
244 36     36   14876 no warnings qw(uninitialized);
  36         419  
  36         2241  
245 0           my $url = join('/',$self->{_actions}{$action},@$url_components);
246 36     36   241 use warnings qw(uninitialized);
  36         79  
  36         23748  
247 0 0         if ($self->batch_mode) {
248 0 0         $url = ($url_components->[0] =~ /{[0-9]+}/) ? join('/',@$url_components) : $url; # index batch object kludge
249 0           @_ = ($self,
250             $url,
251             $rq, $content, $addl_headers);
252 0           goto &_add_to_batch_queue;
253             }
254 0 0 0       $content = $JSON->encode($content) if $content && !$self->isa('Mojo::UserAgent');
255             # request made here
256 0           $resp = $self->{_raw_response} = $self->$rq($url, 'Content-Type' => 'application/json', Content=> $content, %$addl_headers);
257 0           1;
258             }
259             }
260             # exception handling
261             # rt80471...
262 0 0         if (length $resp->content) {
263 0 0         if ($resp->header('Content_Type') =~ /json/) {
264 0           $self->{_decoded_content} = $JSON->decode($resp->content);
265             }
266             }
267 0 0         unless ($resp->is_success) {
268 0 0         if ( $self->{_decoded_content} ) {
269             my %error_fields = (
270             code => $resp->code,
271             neo4j_message => $self->{_decoded_content}->{message},
272             neo4j_exception => $self->{_decoded_content}->{exception},
273             neo4j_stacktrace => $self->{_decoded_content}->{stacktrace}
274 0           );
275 0           my $xclass;
276 0           given ($resp->code) {
277 0           when (404) {
278 0           $xclass = 'REST::Neo4p::NotFoundException';
279             }
280 0           when (409) {
281 0           $xclass = 'REST::Neo4p::ConflictException';
282             }
283 0           default {
284 0           $xclass = 'REST::Neo4p::Neo4jException';
285             }
286             }
287 0 0 0       if ( $error_fields{neo4j_exception} &&
288             ($error_fields{neo4j_exception} =~ /^Syntax/ )) {
289 0           $xclass = 'REST::Neo4p::QuerySyntaxException';
290             }
291 0           $xclass->throw(%error_fields);
292             }
293             else { # couldn't parse the content as JSON...
294 0 0 0       my $xclass = ($resp->code && ($resp->code == 404)) ?
295             'REST::Neo4p::NotFoundException' : 'REST::Neo4p::CommException';
296 0           $xclass->throw(
297             code => $resp->code,
298             message => $resp->message
299             );
300             }
301             }
302 0           $self->{_location} = $resp->header('Location');
303             }
304              
305             sub neo4j_version {
306 0     0 1   my $self = shift;
307 0           my $v = my $a = $self->{_actions}{neo4j_version};
308 0 0         return unless defined $v;
309 0           my ($major, $minor, $patch, $milestone) =
310             $a =~ /^(?:([0-9]+)\.)(?:([0-9]+)\.)?([0-9]+)?(?:-M([0-9]+))?/;
311 0 0         wantarray ? ($major,$minor,$patch,$milestone) : $v;
312             }
313              
314             sub is_version_4 {
315 0     0 0   my ($maj,@rest) = shift->neo4j_version;
316 0           return $maj >= 4;
317             }
318              
319              
320       0     sub DESTROY {}
321              
322             =head1 NAME
323              
324             REST::Neo4p::Agent - HTTP client interacting with Neo4j
325              
326             =head1 SYNOPSIS
327              
328             $agent = REST::Neo4p::Agent->new();
329             $agent->server_url('http://127.0.0.1:7474');
330             unless ($agent->connect) {
331             print STDERR "Didn't find the server\n";
332             }
333              
334             See examples under L below.
335              
336             =head1 DESCRIPTION
337              
338             The agent's job is to encapsulate and connect to the REST service URLs
339             of a running Neo4j server. It also stores the discovered URLs for
340             various actions and provides those URLs as getters from the agent
341             object. The getter names are the keys in the JSON objects returned by
342             the server. See
343             L for more
344             details.
345              
346             API and HTTP errors are distinguished and thrown by
347             L subclasses. See L.
348              
349             A REST::Neo4p::Agent instance is created as a subclass of a choice
350             of HTTP user agents:
351              
352             =over
353              
354             =item * L (default)
355              
356             =item * L
357              
358             =item * L (L with L responses)
359              
360             =back
361              
362             REST::Neo4p::Agent responses are always L objects.
363              
364             REST::Neo4p::Agent will retry requests that fail with
365             L. The default
366             number of retries is 3; the default wait time between retries is 5
367             sec. These can be adjusted by setting the package variables
368              
369             $REST::Neo4p::Agent::RQ_RETRIES
370             $REST::Neo4p::Agent::RETRY_WAIT
371              
372             to the desired values.
373              
374             According to the Neo4j recommendation, the agent requests streamed
375             responses by default; i.e.,
376              
377             X-Stream: true
378              
379             is a default header for requests. The server responds to requests with
380             chunked content, which is handled correctly by any of the underlying
381             user agents.
382              
383             L and L take advantage of
384             streamed responsed by retrieving and returning JSON objects
385             incrementally and (with the L backend) in a
386             non-blocking way. New Neo4j server versions may break the incremental
387             parsing. If this happens, L
388             ticket|https://rt.cpan.org/Public/Bug/Report.html?Queue=REST-Neo4p>. In
389             the meantime, you should be able to keep things going (albeit more
390             slowly) by turning off streaming at the agent:
391              
392             REST::Neo4p->agent->no_stream;
393              
394             Streaming responses can be requested again by issuing
395              
396             REST::Neo4p->agent->stream
397              
398             For batch API features, see L.
399              
400             =head1 METHODS
401              
402             =over
403              
404             =item new()
405              
406             $agent = REST::Neo4p::Agent->new();
407             $agent = REST::Neo4p::Agent->new( agent_module => 'HTTP::Thin');
408             $agent = REST::Neo4p::Agent->new("http://127.0.0.1:7474");
409              
410             Returns a new agent. The C parameter may be set to
411              
412             LWP::UserAgent (default)
413             Mojo::UserAgent
414             HTTP::Thin
415              
416             to select the underlying user agent class. Additional arguments are
417             passed to the user agent constructor.
418              
419             =item server_url()
420              
421             $agent->server_url("http://127.0.0.1:7474");
422              
423             Sets the server address and port.
424              
425             =item data()
426              
427             $neo4j_data_url = $agent->data();
428              
429             Returns the base of the Neo4j server API.
430              
431             =item admin()
432              
433             $neo4j_admin_url = $agent->admin();
434              
435             Returns the Neo4j server admin url.
436              
437             =item node()
438              
439             =item reference_node()
440              
441             =item node_index()
442              
443             =item relationship_index()
444              
445             =item extensions_info()
446              
447             =item relationship_types()
448              
449             =item batch()
450              
451             =item cypher()
452              
453             $relationship_type_url = $agent->relationship_types;
454              
455             These methods get the REST URL for the named API actions. Other named
456             actions may also be available for a given server; these are
457             auto-loaded from self-discovery responses provided by Neo4j. Use
458             C to identify them.
459              
460             You will probably prefer using the L,
461             L, L, and L
462             methods to make requests directly.
463              
464             =item neo4j_version()
465              
466             $version = $agent->neo4j_version;
467             ($major, $minor, $patch, $milestone) = $agent->neo4j_version;
468              
469             Returns the version string/components of the connected Neo4j server.
470              
471             =item available_actions()
472              
473             @actions = $agent->available_actions();
474              
475             Returns all discovered actions.
476              
477             =item location()
478              
479             $agent->post_node(); # create new node
480             $new_node_url = $agent->location;
481              
482             Returns the value of the "location" key in the response JSON.
483              
484             =item get_{action}()
485              
486             $decoded_response = $agent->get_data(@url_components,\%rest_params)
487             $types_array_ref = $agent->get_relationship_types();
488              
489             Makes a GET request to the REST endpoint mapped to {action}. Arguments
490             are additional URL components (without slashes). If the final argument
491             is a hashref, it will be sent as key-value form parameters.
492              
493             =item put_{action}()
494              
495             # add a property to an existing node
496             $agent->put_node([13, 'properties'], { name => 'Herman' });
497              
498             Makes a PUT request to the REST endpoint mapped to {action}. The first
499             argument, if present, must be an array B of additional URL
500             components. The second argument, if present, is a hashref that will be
501             sent in the request as (encoded) JSON content. The third argument, if
502             present, is a hashref containing additional request headers.
503              
504             =item post_{action}()
505              
506             # create a new node with given properties
507             $agent->post_node({ name => 'Wanda' });
508             # do a cypher query and save content to file
509             $agent->post_cypher([], { query => 'MATCH (n) RETURN n', params=>{}},
510             { ':content_file' => $my_file_name });
511              
512             Makes a POST request to the REST endpoint mapped to {action}. The first
513             argument, if present, must be an array B of additional URL
514             components. The second argument, if present, is a hashref that will be
515             sent in the request as (encoded) JSON content. The third argument, if
516             present, is a hashref containing additional request headers.
517              
518             =item delete_{action}()
519              
520             $agent->delete_node(13);
521             $agent->delete_node_index('myindex');
522              
523             Makes a DELETE request to the REST endpoint mapped to {action}. Arguments
524             are additional URL components (without slashes). If the final argument
525             is a hashref, it will be sent in the request as (encoded) JSON content.
526              
527             =item decoded_content()
528              
529             $decoded_json = $agent->decoded_content;
530              
531             Returns the response content of the last agent request, as decoded by
532             L. It is generally a reference, but can be a scalar if a
533             bareword was returned by the server.
534              
535             =item raw_response()
536              
537             $resp = $agent->raw_response
538              
539             Returns the L object returned by the last request made
540             by the backend user agent.
541              
542             =item no_stream()
543              
544             $agent->no_stream;
545              
546             Removes C from the default headers.
547              
548             =item stream()
549              
550             $agent->stream;
551              
552             Adds C to the default headers.
553              
554             =back
555              
556             =head1 Batch Mode
557              
558             B: I
559             the big one along with that API. The Neo4j::Driver agent will complain
560             if you use these methods.>
561              
562             When the agent is in batch mode, the usual request calls are not
563             executed immediately, but added to a queue. The L
564             method sends the queued calls in the format required by the Neo4p REST
565             API (using the C method outside of batch
566             mode). L returns the decoded json server response in
567             the return format specified by the Neo4p REST batch API.
568              
569             =over
570              
571             =item batch_mode()
572              
573             print ($agent->batch_mode ? "I am " : "I am not ")." in batch mode\n";
574             $agent->batch_mode(1);
575              
576             Set/get current agent mode.
577              
578             =item batch_length()
579              
580             if ($agent->batch_length() > $JOB_LIMIT) {
581             print "Queue getting long; better execute\n"
582             }
583              
584             Returns current queue length. Throws
585             L if agent not in
586             batch mode.
587              
588             =item execute_batch()
589              
590             $tmpfh = $agent->execute_batch();
591             $tmpfh = $agent->execute_batch(50);
592              
593             while (<$tmpfn>) {
594             # handle responses
595             }
596              
597             Processes the queued calls and returns the decoded json response from
598             server in a temporary file. Returns with undef if batch length is zero.
599             Throws L if not in batch mode.
600              
601             Second form takes an integer argument; this will submit the next [integer]
602             jobs and return the server response in the tempfile. The batch length is
603             updated.
604              
605             The filehandle returned is a L object. The file will be unlinked
606             when the object is destroyed.
607              
608             =item execute_batch_chunk()
609              
610             while (my $tmpf = $agent->execute_batch_chunk ) {
611             # handle response
612             }
613              
614             Convenience form of
615             C. C<$REST::Neo4p::JOB_CHUNK>
616             has default value of 1024.
617              
618             =back
619              
620             =head1 AUTHOR
621              
622             Mark A. Jensen
623             CPAN ID: MAJENSEN
624             majensen -at- cpan -dot- org
625              
626             =head1 LICENSE
627              
628             Copyright (c) 2012-2020 Mark A. Jensen. This program is free software; you
629             can redistribute it and/or modify it under the same terms as Perl
630             itself.
631              
632             =cut
633              
634             1;