File Coverage

lib/Neo4j/Driver.pm
Criterion Covered Total %
statement 125 125 100.0
branch 70 70 100.0
condition 18 19 94.7
subroutine 22 22 100.0
pod 4 6 100.0
total 239 242 99.5


line stmt bran cond sub pod time code
1 17     17   625670 use 5.010;
  17         191  
2 17     17   90 use strict;
  17         25  
  17         392  
3 17     17   83 use warnings;
  17         30  
  17         449  
4 17     17   8379 use utf8;
  17         200  
  17         86  
5              
6             package Neo4j::Driver;
7             # ABSTRACT: Neo4j community graph database driver for Bolt and HTTP
8             $Neo4j::Driver::VERSION = '0.39';
9              
10 17     17   1005 use Carp qw(croak);
  17         31  
  17         1205  
11              
12 17     17   1821 use URI 1.25;
  17         18945  
  17         449  
13 17     17   6025 use Neo4j::Driver::Events;
  17         41  
  17         490  
14 17     17   6680 use Neo4j::Driver::Session;
  17         55  
  17         636  
15              
16 17     17   6819 use Neo4j::Driver::Type::Node;
  17         39  
  17         569  
17 17     17   6767 use Neo4j::Driver::Type::Relationship;
  17         65  
  17         530  
18 17     17   6300 use Neo4j::Driver::Type::Path;
  17         39  
  17         502  
19 17     17   5938 use Neo4j::Driver::Type::Point;
  17         40  
  17         470  
20 17     17   6406 use Neo4j::Driver::Type::Temporal;
  17         42  
  17         31053  
21              
22              
23             my %NEO4J_DEFAULT_PORT = (
24             bolt => 7687,
25             http => 7474,
26             https => 7473,
27             );
28              
29             my %OPTIONS = (
30             auth => 'auth',
31             ca_file => 'tls_ca',
32             cypher_filter => 'cypher_filter',
33             cypher_params => 'cypher_params_v2',
34             cypher_types => 'cypher_types',
35             encrypted => 'tls',
36             jolt => 'jolt',
37             concurrent_tx => 'concurrent_tx',
38             max_transaction_retry_time => 'max_transaction_retry_time',
39             net_module => 'net_module',
40             timeout => 'timeout',
41             tls => 'tls',
42             tls_ca => 'tls_ca',
43             trust_ca => 'tls_ca',
44             uri => 'uri',
45             );
46              
47             my %DEFAULTS = (
48             cypher_types => {
49             node => 'Neo4j::Driver::Type::Node',
50             relationship => 'Neo4j::Driver::Type::Relationship',
51             path => 'Neo4j::Driver::Type::Path',
52             point => 'Neo4j::Driver::Type::Point',
53             temporal => 'Neo4j::Driver::Type::Temporal',
54             },
55             );
56              
57              
58             sub new {
59 167     167 1 753146 my ($class, $config, @extra) = @_;
60            
61 167         787 my $self = bless { config => { %DEFAULTS }, die_on_error => 1 }, $class;
62 167         661 $self->{plugins} = Neo4j::Driver::Events->new;
63            
64 167 100       507 croak __PACKAGE__ . "->new() with multiple arguments unsupported" if @extra;
65 166 100       600 $config = { uri => $config } if ref $config ne 'HASH';
66 166   100     540 $config->{uri} //= ''; # force config() to call _check_uri()
67 166         383 return $self->config($config);
68             }
69              
70              
71             sub _check_uri {
72 186     186   322 my ($self) = @_;
73            
74 186         314 my $uri = $self->{config}->{uri};
75            
76 186 100       376 if ($uri) {
77 109 100       640 $uri = "[$uri]" if $uri =~ m{^[0-9a-f:]*::|^(?:[0-9a-f]+:){6}}i;
78 109 100 100     808 $uri =~ s|^|http://| if $uri !~ m{:|/} || $uri =~ m{^\[.+\]$};
79 109 100       248 $uri =~ s|^|http:| if $uri =~ m{^//};
80 109         383 $uri = URI->new($uri);
81            
82 109 100       13577 if ( ! $uri->scheme ) {
83 5         116 croak sprintf "Failed to parse URI '%s'", $uri;
84             }
85 104 100       2285 if ( $uri->scheme !~ m/^https?$|^bolt$/ ) {
86 6   50     88 croak sprintf "URI scheme '%s' unsupported; use 'http' or 'bolt'", $uri->scheme // "";
87             }
88            
89 98 100       1560 if (my $userinfo = $uri->userinfo(undef)) {
90 10         577 my @userinfo = $userinfo =~ m/^([^:]*):?(.*)/;
91 10         23 @userinfo = map { URI::Escape::uri_unescape $_ } @userinfo;
  20         152  
92 10         123 utf8::decode $_ for @userinfo;
93 10         22 $self->basic_auth(@userinfo);
94             }
95 98 100       5136 $uri->host('localhost') unless $uri->host;
96 98 100       6813 $uri->path('') if $uri->path_query eq '/';
97 98         1449 $uri->fragment(undef);
98             }
99             else {
100 77         346 $uri = URI->new("http://localhost");
101             }
102 175 100       21762 $uri->port( $NEO4J_DEFAULT_PORT{ $uri->scheme } ) if ! $uri->_port;
103            
104 175         17609 $self->{config}->{uri} = $uri;
105             }
106              
107              
108             sub basic_auth {
109 41     41 1 1578 my ($self, $username, $password) = @_;
110            
111 41 100       193 warnings::warnif deprecated => "Deprecated sequence: call basic_auth() before session()" if $self->{server_info};
112            
113             $self->{config}->{auth} = {
114 41         1564 scheme => 'basic',
115             principal => $username,
116             credentials => $password,
117             };
118            
119 41         98 return $self;
120             }
121              
122              
123             sub config {
124 1478     1478 1 53105 my ($self, @options) = @_;
125            
126 1478 100 100     5219 @options = %{$options[0]} if @options == 1 && ref $options[0] eq 'HASH';
  169         523  
127 1478 100       2636 croak "config() without options unsupported" unless @options;
128            
129 1476 100       2601 if (@options < 2) {
130             # get config option
131 1214         1443 my $key = $options[0];
132 1214 100       24284 croak "Unsupported config option: $key" unless grep m/^$key$/, keys %OPTIONS;
133 1213   100     10543 return $self->{$OPTIONS{$key}} // $self->{config}->{$OPTIONS{$key}};
134             }
135            
136 262 100       563 croak "Unsupported sequence: call config() before session()" if $self->{server_info};
137 261         1577 my %options = $self->_parse_options('config', [keys %OPTIONS], @options);
138            
139             # set config option
140 255         1139 my @keys = reverse sort keys %options; # auth should take precedence over uri
141 255         491 foreach my $key (@keys) {
142 278         723 $self->{config}->{$OPTIONS{$key}} = $options{$key};
143 278 100       847 $self->_check_uri if $OPTIONS{$key} eq 'uri';
144             }
145 244         1387 return $self;
146             }
147              
148              
149             sub session {
150 177     177 1 57863 my ($self, @options) = @_;
151            
152 177 100       544 if (! $self->{server_info}) {
153 89         918 warnings::warnif deprecated => sprintf "Internal API %s->{%s} may be unavailable in Neo4j::Driver 1.00", __PACKAGE__, $_ for grep { $self->{$_} } @OPTIONS{ sort keys %OPTIONS };
  1335         1865  
154             }
155            
156 177         507 $self->{plugins}->{die_on_error} = $self->{die_on_error};
157 177 100       458 warnings::warnif deprecated => __PACKAGE__ . "->{die_on_error} is deprecated" unless $self->{die_on_error};
158 177 100       3320 warnings::warnif deprecated => __PACKAGE__ . "->{http_timeout} is deprecated; use config()" if defined $self->{http_timeout};
159 177   100     1286 $self->{config}->{timeout} //= $self->{http_timeout};
160            
161 177 100 100     514 @options = %{$options[0]} if @options == 1 && ref $options[0] eq 'HASH';
  2         8  
162 177         587 my %options = $self->_parse_options('session', ['database'], @options);
163            
164 176         945 my $session = Neo4j::Driver::Session->new($self);
165 168         808 return $session->_connect($options{database});
166             }
167              
168              
169             sub _parse_options {
170 438     438   1093 my (undef, $context, $supported, @options) = @_;
171            
172 438 100       1003 croak "Odd number of elements in $context options hash" if @options & 1;
173 436         943 my %options = @options;
174            
175 436 100       909 warnings::warnif deprecated => "Config option ca_file is deprecated; use trust_ca" if $options{ca_file};
176 436 100       1634 warnings::warnif deprecated => "Config option cypher_types is deprecated" if $options{cypher_types};
177 436 100       1316 if ($options{cypher_params}) {
    100          
178 26 100       128 croak "Unimplemented cypher params filter '$options{cypher_params}'" if $options{cypher_params} ne v2;
179             }
180             elsif ($options{cypher_filter}) {
181 2         41 warnings::warnif deprecated => "Config option cypher_filter is deprecated; use cypher_params";
182 2 100       1722 croak "Unimplemented cypher filter '$options{cypher_filter}'" if $options{cypher_filter} ne 'params';
183 1         3 $options{cypher_params} = v2;
184             }
185 434 100       877 warnings::warnif deprecated => "Config option jolt is deprecated: Jolt is now enabled by default" if defined $options{jolt};
186 434 100       3261 warnings::warnif deprecated => "Config option net_module is deprecated; use plug-in interface" if defined $options{net_module};
187            
188 434         2204 my @unsupported = ();
189 434         891 foreach my $key (keys %options) {
190 373 100       7901 push @unsupported, $key unless grep m/^$key$/, @$supported;
191             }
192 434 100       1157 croak "Unsupported $context option: " . join ", ", sort @unsupported if @unsupported;
193            
194 431         1710 return %options;
195             }
196              
197              
198             sub plugin {
199             # uncoverable pod (experimental feature)
200 76     76 0 3298 my ($self, $package, @extra) = @_;
201            
202 76 100       200 croak "plugin() with more than one argument is unsupported" if @extra;
203 75         330 $self->{plugins}->_register_plugin($package);
204 75         272 return $self;
205             }
206              
207              
208             sub close {
209             # uncoverable pod (see Deprecations.pod)
210 1     1 0 2724 warnings::warnif deprecated => __PACKAGE__ . "->close() is deprecated";
211             }
212              
213              
214              
215              
216             package # private
217             URI::bolt;
218              
219 17     17   169 use parent 'URI::_server';
  17         46  
  17         134  
220              
221             # The server methods need to be available for bolt: URI instances
222             # even when the Neo4j-Bolt distribution is not installed.
223              
224            
225             1;
226              
227             __END__