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   283 use 5.010;
  17         55  
2 17     17   83 use strict;
  17         25  
  17         402  
3 17     17   76 use warnings;
  17         22  
  17         448  
4 17     17   76 use utf8;
  17         32  
  17         126  
5              
6             package Neo4j::Driver::Session;
7             # ABSTRACT: Context of work for database interactions
8             $Neo4j::Driver::Session::VERSION = '0.39';
9              
10 17     17   1033 use Carp qw(croak);
  17         27  
  17         1342  
11             our @CARP_NOT = qw(
12             Neo4j::Driver
13             Try::Tiny
14             );
15 17     17   178 use List::Util qw(min);
  17         35  
  17         1960  
16 17     17   130 use Scalar::Util qw(blessed);
  17         34  
  17         772  
17 17     17   9036 use Time::HiRes ();
  17         23683  
  17         524  
18 17     17   7739 use Try::Tiny;
  17         32002  
  17         1037  
19 17     17   105 use URI 1.25;
  17         249  
  17         379  
20              
21 17     17   6638 use Neo4j::Driver::Net::Bolt;
  17         48  
  17         595  
22 17     17   6856 use Neo4j::Driver::Net::HTTP;
  17         53  
  17         727  
23 17     17   7064 use Neo4j::Driver::Transaction;
  17         39  
  17         506  
24 17     17   102 use Neo4j::Error;
  17         39  
  17         14966  
25              
26              
27             sub new {
28             # uncoverable pod (private method)
29 176     176 0 437 my ($class, $driver) = @_;
30            
31 176 100       493 return Neo4j::Driver::Session::Bolt->new($driver) if $driver->config('uri')->scheme eq 'bolt';
32 163         4531 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   548 my ($self, $database) = @_;
40            
41 168         478 my $neo4j_version = $self->server->agent; # ensure contact with the server has been made
42 166 100       529 $self->{cypher_params_v2} = 0 if $neo4j_version =~ m{^Neo4j/2\.}; # no conversion required
43            
44 166   100     577 $database //= $self->server->_default_database($self->{driver});
45 164         602 $self->{net}->_set_database($database);
46 164         895 return $self;
47             }
48              
49              
50             sub begin_transaction {
51 34     34 1 10685 my ($self) = @_;
52            
53 34         103 return $self->new_tx->_begin;
54             }
55              
56              
57             sub run {
58 182     182 1 157713 my ($self, $query, @parameters) = @_;
59            
60 182         466 return $self->new_tx->_run_autocommit($query, @parameters);
61             }
62              
63              
64             sub _execute {
65 33     33   97 my ($self, $mode, $func) = @_;
66            
67 33 100       142 croak sprintf "%s->execute_%s() requires subroutine ref", __PACKAGE__, lc $mode unless ref $func eq 'CODE';
68            
69 31   100     162 $self->{retry_sleep} //= 1;
70 31         49 my (@r, $r);
71 31         83 my $wantarray = wantarray;
72             my $time_stop = Time::HiRes::time
73 31   100     167 + ($self->{driver}->config('max_transaction_retry_time') // 30); # seconds
74 31         56 my $tries = 0;
75 31         48 my $success = 0;
76 31         42 do {
77 37         203 my $tx = $self->new_tx($mode);
78 37     11   223 $tx->{error_handler} = sub { die shift };
  11         135  
79            
80             try {
81 37     37   4274 $tx->_begin;
82 34         65 $tx->{managed} = 1; # Disallow commit() in $func
83 34 100       74 if ($wantarray) {
84 3         8 @r = $func->($tx);
85             }
86             else {
87 31         80 $r = $func->($tx);
88             }
89 15         63 $tx->{managed} = 0;
90 15         52 $tx->commit;
91 15         31 $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   5602 $tx->{managed} = 0;
96 22         144 try { $tx->rollback };
  22         1458  
97            
98             # Never retry non-Neo4j errors
99 22 100 100     15638 croak $_ unless blessed $_ && $_->isa('Neo4j::Error');
100            
101 11 100 100     53 if (! $_->is_retryable || Time::HiRes::time >= $time_stop) {
102 5         296 $self->{driver}->{plugins}->trigger( error => $_ );
103 1         36 $success = -1; # return in case the event handler doesn't die
104             }
105             else {
106             Time::HiRes::sleep min
107 6         139110 $self->{retry_sleep} * (1 << $tries++),
108             $time_stop - Time::HiRes::time;
109             }
110 37         488 };
111             } until ($success);
112 16 100       471 return $wantarray ? @r : $r;
113             }
114              
115              
116             sub execute_read {
117 19     19 1 13280 my ($self, $func) = @_;
118            
119 19         51 return $self->_execute( READ => $func );
120             }
121              
122              
123             sub execute_write {
124 14     14 1 7369 my ($self, $func) = @_;
125            
126 14         42 return $self->_execute( WRITE => $func );
127             }
128              
129              
130             sub close {
131             # uncoverable pod (see Deprecations.pod)
132 1     1 0 1733 warnings::warnif deprecated => __PACKAGE__ . "->close() is deprecated";
133             }
134              
135              
136             sub server {
137 255     255 1 4379 my ($self) = @_;
138            
139 255         488 my $server_info = $self->{driver}->{server_info};
140 255 100       917 return $server_info if defined $server_info;
141 81         297 return $self->{driver}->{server_info} = $self->{net}->_server;
142             }
143              
144              
145              
146              
147             package # private
148             Neo4j::Driver::Session::Bolt;
149 17     17   143 use parent -norequire => 'Neo4j::Driver::Session';
  17         49  
  17         85  
150              
151              
152             sub new {
153 13     13   348 my ($class, $driver) = @_;
154            
155 13         30 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   113 return Neo4j::Driver::Transaction::Bolt->new(@_);
165             }
166              
167              
168              
169              
170             package # private
171             Neo4j::Driver::Session::HTTP;
172 17     17   3033 use parent -norequire => 'Neo4j::Driver::Session';
  17         39  
  17         102  
173              
174              
175             sub new {
176 167     167   2220 my ($class, $driver) = @_;
177            
178 167         456 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   1273 return Neo4j::Driver::Transaction::HTTP->new(@_);
188             }
189              
190              
191             1;
192              
193             __END__