view release on metacpan or  search on metacpan

lib/Neo4j/Driver/Net/HTTP/LWP.pm  view on Meta::CPAN

		$uri = $uri->clone;
		$uri->userinfo($userinfo);
	}
	$self->{uri_base} = $uri;
	
	my $version = $Neo4j::Driver::Net::HTTP::LWP::VERSION;
	my $agent = $self->{agent} = LWP::UserAgent->new(
		# User-Agent: Neo4j-Driver/0.21 libwww-perl/6.52
		agent => sprintf("Neo4j-Driver%s ", $version ? "/$version" : ""),
		timeout => $driver->config('timeout'),
	);
	$agent->default_headers->header( 'X-Stream' => 'true' );
	
	if ($uri->scheme eq 'https') {
		my $unencrypted = defined $driver->config('encrypted') && ! $driver->config('encrypted');
		croak "HTTPS does not support unencrypted communication; use HTTP" if $unencrypted;
		$agent->ssl_opts( verify_hostname => 1 );
		if (defined( my $trust_ca = $driver->config('trust_ca') )) {
			croak sprintf "trust_ca file '%s' can't be used: %s", $trust_ca, $!
				unless open my $fh, '<', $trust_ca;
			$agent->ssl_opts( SSL_ca_file => $trust_ca );
		}
	}
	else {
		croak "HTTP does not support encrypted communication; use HTTPS" if $driver->config('encrypted');
	}
	
	return $self;
}


sub ua { shift->{agent} }

sub uri { shift->{uri_base} }

sub json_coder { shift->{json_coder} }

sub http_reason { shift->{response}->message // '' }

sub date_header { scalar shift->{response}->header('Date') // '' }


sub http_header {
	my $response = shift->{response};
	my $header = {
		content_type => scalar $response->header('Content-Type') // '',
		location     => scalar $response->header('Location') // '',
		status       => $response->code // '',
		success      => $response->is_success,
	};
	if ( ! $header->{success} && $response->header('Client-Warning') // '' eq 'Internal response' ) {
		$header->{content_type} = '';
		$header->{status}       = '';
	}
	return $header;
}


sub fetch_event {
	my ($self) = @_;
	$self->{buffer} = [grep { length } split m/\n|\x{1e}/, $self->fetch_all] unless defined $self->{buffer};
	return shift @{$self->{buffer}};
}


sub fetch_all {
	my ($self) = @_;
	return $self->{response}->content;
}


sub request {
	my ($self, $method, $url, $json, $accept, $mode) = @_;
	
	$self->{buffer} = undef;
	
	$url = URI->new_abs( $url, $self->{uri_base} );
	$method = lc $method;
	if ($json) {
		$self->{response} = $self->{agent}->$method(
			$url,
			'Accept' => $accept,
			'Content' => $self->{json_coder}->encode($json),
			'Content-Type' => $CONTENT_TYPE,
			$mode ? ('Access-Mode' => $mode) : ()
		);
	}
	else {
		$self->{response} = $self->{agent}->$method(
			$url,
			'Accept' => $accept,
		);
	}
}


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Neo4j::Driver::Net::HTTP::LWP - HTTP network adapter for libwww-perl

=head1 VERSION

version 1.02

=head1 SYNOPSIS

 use parent 'Neo4j::Driver::Plugin';
 
 sub register {
   my ($self, $manager) = @_;
   $manager->add_handler(
     http_adapter_factory => sub {
       my ($continue, $driver) = @_;