File Coverage

lib/Neo4j/Driver.pm

Criterion	Covered	Total	%
statement	101	101	100.0
branch	66	66	100.0
condition	11	11	100.0
subroutine	18	18	100.0
pod	5	5	100.0
total	201	201	100.0

use v5.12;
use warnings;

package Neo4j::Driver 1.02;
# ABSTRACT: Neo4j community graph database driver for Bolt and HTTP


use Carp qw(croak);
use List::Util 1.33 qw(none);

use URI 1.25;
use Neo4j::Driver::Events;
use Neo4j::Driver::Session;


my %NEO4J_DEFAULT_PORT = (
	bolt => 7687,
	http => 7474,
	https => 7473,
);

my %OPTIONS = (
	auth => 'auth',
	cypher_params => 'cypher_params_v2',
	concurrent_tx => 'concurrent_tx',
	encrypted => 'encrypted',
	max_transaction_retry_time => 'max_transaction_retry_time',
	timeout => 'timeout',
	tls => 'encrypted',
	tls_ca => 'trust_ca',
	trust_ca => 'trust_ca',
	uri => 'uri',
);


sub new {
	my ($class, $config, @extra) = @_;

	my $self = bless {}, $class;
	$self->{events} = Neo4j::Driver::Events->new;

	croak __PACKAGE__ . "->new() with multiple arguments unsupported" if @extra;
	$config = { uri => $config } if ref $config ne 'HASH';
	$config->{uri} //= '';  # force config() to call _check_uri()
	return $self->config($config);
}


sub _check_uri {
	my ($self) = @_;

	my $uri = $self->{config}->{uri};

	if ($uri) {
		$uri = "[$uri]" if $uri =~ m{^[0-9a-f:]*::|^(?:[0-9a-f]+:){6}}i;
		$uri =~ s|^|neo4j://| if $uri !~ m{:|/} || $uri =~ m{^\[.+\]$};
		$uri =~ s|^|neo4j:| if $uri =~ m{^//};
		$uri = URI->new($uri);

		$uri->scheme or croak
			sprintf "Failed to parse URI '%s'", $uri;
		$uri->scheme =~ m/^(?:https?|bolt|neo4j)$/i or croak
			sprintf "URI scheme '%s' unsupported; use 'bolt', 'http', or 'neo4j'", $uri->scheme;

		if (my $userinfo = $uri->userinfo(undef)) {
			my @userinfo = $userinfo =~ m/^([^:]*):?(.*)/;
			@userinfo = map { URI::Escape::uri_unescape $_ } @userinfo;
			utf8::decode $_ for @userinfo;
			$self->basic_auth(@userinfo);
		}
		$uri->host('127.0.0.1') unless $uri->host;
		$uri->path('') if $uri->path_query eq '/';
		$uri->fragment(undef);
	}
	else {
		$uri = URI->new("neo4j://127.0.0.1");
	}
	$uri->port( $NEO4J_DEFAULT_PORT{ $uri->scheme } ) if ! $uri->_port;

	$self->{config}->{uri} = $uri;
}


sub _fix_neo4j_uri {
	my ($self) = @_;

	croak "The concurrent_tx config option may only be used with http:/https: URIs" if $self->{config}->{concurrent_tx};

	my $uri = $self->{config}->{uri};
	$uri->scheme( exists $INC{'Neo4j/Bolt.pm'} ? 'bolt' : $self->{config}->{encrypted} ? 'https' : 'http' );
	$uri->port( $NEO4J_DEFAULT_PORT{ $uri->scheme } ) if ! $uri->_port;
}


sub basic_auth {
	my ($self, $username, $password) = @_;

	croak "Unsupported sequence: call basic_auth() before session()" if $self->{server_info};

	$self->{config}->{auth} = {
		scheme => 'basic',
		principal => $username,
		credentials => $password,
	};

	return $self;
}


sub config {
	my ($self, @options) = @_;

	@options = %{$options[0]} if @options == 1 && ref $options[0] eq 'HASH';
	croak "config() without options unsupported" unless @options;

	if (@options < 2) {
		# get config option
		my $key = $options[0];
		croak sprintf "Unsupported config option: %s", $key if none {$_ eq $key} keys %OPTIONS;
		return $self->{config}->{$OPTIONS{$key}};
	}

	croak "Unsupported sequence: call config() before session()" if $self->{server_info};
	my %options = $self->_parse_options('config', [keys %OPTIONS], @options);

	# set config option
	my @keys = reverse sort keys %options;  # auth should take precedence over uri
	foreach my $key (@keys) {
		$self->{config}->{$OPTIONS{$key}} = $options{$key};
		$self->_check_uri if $OPTIONS{$key} eq 'uri';
	}
	return $self;
}


sub session {
	my ($self, @options) = @_;

	@options = %{$options[0]} if @options == 1 && ref $options[0] eq 'HASH';
	my %options = $self->_parse_options('session', ['database'], @options);

	$self->_fix_neo4j_uri if $self->{config}->{uri}->scheme eq 'neo4j';

	my $session = Neo4j::Driver::Session->new($self);
	return $session->_connect($options{database});
}


sub _parse_options {
	my (undef, $context, $supported, @options) = @_;

	croak sprintf "Odd number of elements in %s options hash", $context if @options & 1;
	my %options = @options;

	warnings::warnif deprecated => "Config option tls is deprecated; use encrypted" if $options{tls};
	warnings::warnif deprecated => "Config option tls_ca is deprecated; use trust_ca" if $options{tls_ca};

	if ($options{cypher_params}) {
		$options{cypher_params} =~ m<^(?:\x02|v2)$> or croak
			sprintf "Unimplemented cypher params filter '%s'", $options{cypher_params};
	}

	my @unsupported = grep { my $key = $_; none {$_ eq $key} @$supported } keys %options;
	@unsupported and croak
		sprintf "Unsupported %s option: %s", $context, join ", ", sort @unsupported;

	return %options;
}


sub plugin {
	my ($self, $plugin, @extra) = @_;

	croak "plugin() with more than one argument is unsupported" if @extra;
	croak "Unsupported sequence: call plugin() before session()" if $self->{server_info};
	$self->{events}->_register_plugin($plugin);
	return $self;
}




package # private
        URI::bolt;

use parent 'URI::_server';

# The server methods need to be available for bolt: URI instances
# even when the Neo4j-Bolt distribution is not installed.


1;

__END__