File Coverage

blib/lib/ArangoDB/Connection.pm
Criterion Covered Total %
statement 56 83 67.4
branch 10 22 45.4
condition 5 8 62.5
subroutine 14 17 82.3
pod 0 5 0.0
total 85 135 62.9


line stmt bran cond sub pod time code
1             package ArangoDB::Connection;
2 8     8   42 use strict;
  8         16  
  8         270  
3 8     8   40 use warnings;
  8         12  
  8         192  
4 8     8   42 use utf8;
  8         14  
  8         50  
5 8     8   245 use 5.008001;
  8         25  
  8         381  
6 8     8   9137 use JSON ();
  8         222381  
  8         221  
7 8     8   19237 use Furl::HTTP;
  8         10165779  
  8         750  
8 8     8   12715 use MIME::Base64;
  8         29117  
  8         746  
9 8     8   7141 use ArangoDB::ConnectOptions;
  8         33  
  8         269  
10 8     8   9415 use ArangoDB::ServerException;
  8         29  
  8         331  
11 8     8   66 use Class::Accessor::Lite ( ro => [qw/options/] );
  8         17  
  8         45  
12              
13             my $JSON = JSON->new->utf8;
14              
15             sub new {
16 16     16 0 29 my ( $class, $options ) = @_;
17 16         68 my $opts = ArangoDB::ConnectOptions->new($options);
18 6 100       25 my $headers = [ Host => $opts->host, Connection => $opts->keep_alive ? 'Keep-Alive' : 'Close', ];
19 6 100 100     21 if ( $opts->auth_type && $opts->auth_user ) {
20 1         6 push @$headers, Authorization =>
21             sprintf( '%s %s', $opts->auth_type, encode_base64( $opts->auth_user . ':' . $opts->auth_passwd ) );
22             }
23 6         24 my %furl_args = (
24             timeout => $opts->timeout,
25             headers => $headers,
26             proxy => $opts->proxy,
27             );
28 6 100       19 if( $opts->inet_aton ){
29 1         6 $furl_args{inet_aton} = $opts->inet_aton;
30             }
31 6         42 my $furl = Furl::HTTP->new(%furl_args);
32              
33 6         331 my $self = bless {
34             options => $opts,
35             _req_args => {
36             scheme => 'http',
37             host => $opts->host,
38             port => $opts->port,
39             },
40             _http_agent => $furl,
41             }, $class;
42              
43 6         39 return $self;
44             }
45              
46             sub http_get {
47 1     1 0 2 my ( $self, $path, $additional_headers ) = @_;
48 1         6 my $headers = $self->_build_headers(undef, $additional_headers );
49 1         9 my ( undef, $code, $msg, undef, $body ) = $self->{_http_agent}->request(
50 1         6 %{ $self->{_req_args} },
51             method => 'GET',
52             path_query => $path,
53             headers => $headers,
54             );
55 1         17646 return $self->_parse_response( $code, $msg, $body );
56             }
57              
58             sub http_post {
59 0     0 0 0 my ( $self, $path, $data, $raw, $additional_headers ) = @_;
60 0 0       0 if( !$raw ){
61 0 0       0 $data = $JSON->encode( defined $data ? $data : {} );
62             }
63 0         0 my $headers = $self->_build_headers($data, $additional_headers);
64 0         0 my ( undef, $code, $msg, undef, $body ) = $self->{_http_agent}->request(
65 0         0 %{ $self->{_req_args} },
66             method => 'POST',
67             path_query => $path,
68             headers => $headers,
69             content => $data,
70             );
71 0         0 return $self->_parse_response( $code, $msg, $body );
72             }
73              
74             sub http_put {
75 0     0 0 0 my ( $self, $path, $data, $raw, $additional_headers ) = @_;
76 0 0       0 if( !$raw ){
77 0 0       0 $data = $JSON->encode( defined $data ? $data : {} );
78             }
79 0         0 my $headers = $self->_build_headers($data, $additional_headers);
80 0         0 my ( undef, $code, $msg, undef, $body ) = $self->{_http_agent}->request(
81 0         0 %{ $self->{_req_args} },
82             method => 'PUT',
83             path_query => $path,
84             headers => $headers,
85             content => $data,
86             );
87 0         0 return $self->_parse_response( $code, $msg, $body );
88             }
89              
90             sub http_delete {
91 0     0 0 0 my ( $self, $path, $additional_headers ) = @_;
92 0         0 my $headers = $self->_build_headers(undef, $additional_headers);
93 0         0 my ( undef, $code, $msg, undef, $body ) = $self->{_http_agent}->request(
94 0         0 %{ $self->{_req_args} },
95             method => 'DELETE',
96             path_query => $path,
97             headers => $headers,
98             );
99 0         0 return $self->_parse_response( $code, $msg, $body );
100             }
101              
102             sub _build_headers {
103 1     1   3 my ( $self, $body, $additional_headers ) = @_;
104 1   50     8 my $content_length = length( $body || q{} );
105 1         4 my @headers = ();
106 1 50       5 if ( $content_length > 0 ) {
107 0         0 push @headers, 'Content-Type' => 'application/json';
108             }
109 1 50       4 if( $additional_headers ){
110 0         0 push @headers, @{ $additional_headers };
  0         0  
111             }
112 1         2 return \@headers;
113             }
114              
115             sub _parse_response {
116 1     1   5 my ( $self, $code, $status, $body ) = @_;
117 1 50 33     18 if ( $code < 200 || $code >= 400 ) {
118 1 50       7 if ( $body ne q{} ) {
119 1         74 my $details = $JSON->decode($body);
120 0           my $exception = ArangoDB::ServerException->new( code => $code, status => $status, detail => $details );
121 0           die $exception;
122             }
123 0           die ArangoDB::ServerException->new( code => $code, status => $status, detail => {} );
124             }
125 0           my $data = $JSON->decode($body);
126 0           return $data;
127             }
128              
129             1;
130             __END__