File Coverage

lib/Neo4j/Driver/Session.pm
Criterion Covered Total %
statement 105 105 100.0
branch 16 16 100.0
condition 13 13 100.0
subroutine 32 32 100.0
pod 5 7 100.0
total 171 173 100.0


line stmt bran cond sub pod time code
1 17     17   285 use 5.010;
  17         52  
2 17     17   86 use strict;
  17         23  
  17         409  
3 17     17   73 use warnings;
  17         29  
  17         415  
4 17     17   75 use utf8;
  17         38  
  17         108  
5              
6             package Neo4j::Driver::Session;
7             # ABSTRACT: Context of work for database interactions
8             $Neo4j::Driver::Session::VERSION = '0.40';
9              
10 17     17   1091 use Carp qw(croak);
  17         28  
  17         1370  
11             our @CARP_NOT = qw(
12             Neo4j::Driver
13             Try::Tiny
14             );
15 17     17   184 use List::Util qw(min);
  17         28  
  17         2110  
16 17     17   132 use Scalar::Util qw(blessed);
  17         20  
  17         833  
17 17     17   9349 use Time::HiRes ();
  17         23458  
  17         487  
18 17     17   7924 use Try::Tiny;
  17         32483  
  17         1021  
19 17     17   106 use URI 1.25;
  17         244  
  17         386  
20              
21 17     17   6708 use Neo4j::Driver::Net::Bolt;
  17         36  
  17         529  
22 17     17   6856 use Neo4j::Driver::Net::HTTP;
  17         53  
  17         692  
23 17     17   7093 use Neo4j::Driver::Transaction;
  17         37  
  17         527  
24 17     17   107 use Neo4j::Error;
  17         41  
  17         15153  
25              
26              
27             sub new {
28             # uncoverable pod (private method)
29 176     176 0 473 my ($class, $driver) = @_;
30            
31 176 100       440 return Neo4j::Driver::Session::Bolt->new($driver) if $driver->config('uri')->scheme eq 'bolt';
32 163         4408 return Neo4j::Driver::Session::HTTP->new($driver);
33             }
34              
35              
36             # Connect and get ServerInfo (via Bolt HELLO or HTTP Discovery API),
37             # then determine the default database name for Neo4j >= 4.
38             sub _connect {
39 168     168   463 my ($self, $database) = @_;
40            
41 168         520 my $neo4j_version = $self->server->agent; # ensure contact with the server has been made
42 166 100       512 $self->{cypher_params_v2} = 0 if $neo4j_version =~ m{^Neo4j/2\.}; # no conversion required
43            
44 166   100     539 $database //= $self->server->_default_database($self->{driver});
45 164         578 $self->{net}->_set_database($database);
46 164         898 return $self;
47             }
48              
49              
50             sub begin_transaction {
51 34     34 1 11203 my ($self) = @_;
52            
53 34         103 return $self->new_tx->_begin;
54             }
55              
56              
57             sub run {
58 182     182 1 161661 my ($self, $query, @parameters) = @_;
59            
60 182         478 return $self->new_tx->_run_autocommit($query, @parameters);
61             }
62              
63              
64             sub _execute {
65 33     33   67 my ($self, $mode, $func) = @_;
66            
67 33 100       111 croak sprintf "%s->execute_%s() requires subroutine ref", __PACKAGE__, lc $mode unless ref $func eq 'CODE';
68            
69 31   100     115 $self->{retry_sleep} //= 1;
70 31         39 my (@r, $r);
71 31         49 my $wantarray = wantarray;
72             my $time_stop = Time::HiRes::time
73 31   100     135 + ($self->{driver}->config('max_transaction_retry_time') // 30); # seconds
74 31         56 my $tries = 0;
75 31         35 my $success = 0;
76 31         43 do {
77 37         131 my $tx = $self->new_tx($mode);
78 37     11   214 $tx->{error_handler} = sub { die shift };
  11         124  
79            
80             try {
81 37     37   3937 $tx->_begin;
82 34         72 $tx->{managed} = 1; # Disallow commit() in $func
83 34 100       71 if ($wantarray) {
84 3         9 @r = $func->($tx);
85             }
86             else {
87 31         98 $r = $func->($tx);
88             }
89 15         102 $tx->{managed} = 0;
90 15         47 $tx->commit;
91 15         34 $success = 1; # return from sub not possible in a Try::Tiny block
92             }
93             catch {
94             # The tx may or may not already be closed; we need to make sure
95 22     22   5606 $tx->{managed} = 0;
96 22         142 try { $tx->rollback };
  22         1446  
97            
98             # Never retry non-Neo4j errors
99 22 100 100     13919 croak $_ unless blessed $_ && $_->isa('Neo4j::Error');
100            
101 11 100 100     36 if (! $_->is_retryable || Time::HiRes::time >= $time_stop) {
102 5         209 $self->{driver}->{plugins}->trigger( error => $_ );
103 1         45 $success = -1; # return in case the event handler doesn't die
104             }
105             else {
106             Time::HiRes::sleep min
107 6         109981 $self->{retry_sleep} * (1 << $tries++),
108             $time_stop - Time::HiRes::time;
109             }
110 37         397 };
111             } until ($success);
112 16 100       463 return $wantarray ? @r : $r;
113             }
114              
115              
116             sub execute_read {
117 19     19 1 11778 my ($self, $func) = @_;
118            
119 19         53 return $self->_execute( READ => $func );
120             }
121              
122              
123             sub execute_write {
124 14     14 1 6919 my ($self, $func) = @_;
125            
126 14         40 return $self->_execute( WRITE => $func );
127             }
128              
129              
130             sub close {
131             # uncoverable pod (see Deprecations.pod)
132 1     1 0 1818 warnings::warnif deprecated => __PACKAGE__ . "->close() is deprecated";
133             }
134              
135              
136             sub server {
137 255     255 1 5102 my ($self) = @_;
138            
139 255         480 my $server_info = $self->{driver}->{server_info};
140 255 100       930 return $server_info if defined $server_info;
141 81         302 return $self->{driver}->{server_info} = $self->{net}->_server;
142             }
143              
144              
145              
146              
147             package # private
148             Neo4j::Driver::Session::Bolt;
149 17     17   144 use parent -norequire => 'Neo4j::Driver::Session';
  17         31  
  17         94  
150              
151              
152             sub new {
153 13     13   367 my ($class, $driver) = @_;
154            
155 13         54 return bless {
156             cypher_params_v2 => $driver->config('cypher_params'),
157             driver => $driver,
158             net => Neo4j::Driver::Net::Bolt->new($driver),
159             }, $class;
160             }
161              
162              
163             sub new_tx {
164 27     27   99 return Neo4j::Driver::Transaction::Bolt->new(@_);
165             }
166              
167              
168              
169              
170             package # private
171             Neo4j::Driver::Session::HTTP;
172 17     17   3312 use parent -norequire => 'Neo4j::Driver::Session';
  17         41  
  17         94  
173              
174              
175             sub new {
176 167     167   2243 my ($class, $driver) = @_;
177            
178 167         366 return bless {
179             cypher_params_v2 => $driver->config('cypher_params'),
180             driver => $driver,
181             net => Neo4j::Driver::Net::HTTP->new($driver),
182             }, $class;
183             }
184              
185              
186             sub new_tx {
187 226     226   1164 return Neo4j::Driver::Transaction::HTTP->new(@_);
188             }
189              
190              
191             1;
192              
193             __END__