| 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__ |