File Coverage

blib/lib/WebService/DigitalOcean/Role/UserAgent.pm
Criterion Covered Total %
statement 43 55 78.1
branch 5 10 50.0
condition 0 2 0.0
subroutine 10 12 83.3
pod 1 1 100.0
total 59 80 73.7


line stmt bran cond sub pod time code
1             package WebService::DigitalOcean::Role::UserAgent;
2             # ABSTRACT: User Agent Role for DigitalOcean WebService
3 2     2   18671 use Moo::Role;
  2         4  
  2         13  
4 2     2   555 use LWP::UserAgent;
  2         8  
  2         58  
5 2     2   10 use JSON ();
  2         12  
  2         50  
6 2     2   11 use DateTime;
  2         4  
  2         56  
7 2     2   9 use Types::Standard qw/is_HashRef/;
  2         1  
  2         40  
8 2     2   886 use utf8;
  2         3  
  2         14  
9              
10             our $VERSION = '0.024'; # VERSION
11              
12             has ua => (
13             is => 'lazy',
14             );
15              
16             sub _build_ua {
17 0     0   0 my ($self) = @_;
18              
19 0   0     0 my $version = __PACKAGE__->VERSION || 'devel';
20              
21 0         0 my @headers = (
22             'Authorization' => 'Bearer ' . $self->token,
23             'Content-Type' => 'application/json; charset=utf-8',
24             );
25              
26 0         0 my $ua = LWP::UserAgent->new(
27             agent => 'WebService::DigitalOcean/' . $version,
28             default_headers => HTTP::Headers->new(@headers),
29             );
30              
31 0         0 return $ua;
32             }
33              
34             sub _build_request {
35 1     1   2 my ( $self, $method, $uri, $data ) = @_;
36              
37 1         6 my $full_url = $self->api_base_url . $uri;
38 1 50       19 my $encoded_data = $data ? JSON::encode_json($data) : undef;
39 1         2 my $headers = undef;
40              
41 1         10 return HTTP::Request->new( $method, $full_url, $headers, $encoded_data );
42             }
43              
44             sub _send_request {
45 0     0   0 my ($self, $request) = @_;
46              
47 0         0 my $response = $self->ua->request($request);
48              
49 0         0 return $response;
50             }
51              
52             sub make_request {
53 1     1 1 2 my ($self, $method, $uri, $data) = @_;
54              
55 1         5 my $request = $self->_build_request( $method, $uri, $data );
56 1         249459 my $response = $self->_send_request($request);
57              
58 1         14 my $result = {
59             request_object => $request,
60             response_object => $response,
61             is_success => $response->is_success,
62             status_line => $response->status_line,
63             };
64              
65 1         45 my $ratelimit = $self->_get_ratelimit( $response->headers );
66              
67 1         486 my $content = $self->_get_content(
68             # avoid ``wantarray`` problems by setting scalar context
69             my $ct = $response->content_type,
70             my $dc = $response->decoded_content,
71             );
72              
73 1         16 return { %$result, %$ratelimit, %$content };
74             }
75              
76             sub _get_ratelimit {
77 1     1   11 my ($self, $headers) = @_;
78              
79 1         7 my $limit = $headers->header('RateLimit-Limit');
80              
81 1 50       67 if (!$limit) {
82 0         0 return {};
83             }
84              
85             return {
86 1         4 ratelimit => {
87             limit => $limit,
88             remaining => $headers->header('RateLimit-Remaining'),
89             reset => DateTime->from_epoch(
90             epoch => $headers->header('RateLimit-Reset')
91             ),
92             }
93             };
94             }
95              
96             sub _get_content {
97 1     1   256 my ($self, $content_type, $content) = @_;
98              
99 1 50       5 if ($content_type ne 'application/json') {
100 0         0 warn "Unexpected Content-Type " . $content_type;
101 0         0 return {};
102             }
103              
104 1         36 my $decoded_response = JSON::decode_json( $content );
105              
106 1 50       12 if ( !is_HashRef($decoded_response) ) {
107 0         0 return { content => $decoded_response };
108             }
109              
110 1         3 my $meta = delete $decoded_response->{meta};
111 1         3 my $links = delete $decoded_response->{links};
112              
113 1         4 my @values = values %$decoded_response;
114              
115 1 50       5 my $c = scalar @values == 1
116             ? $values[0]
117             : $decoded_response
118             ;
119              
120             return {
121 1         7 meta => $meta,
122             links => $links,
123             content => $c,
124             };
125             }
126              
127             1;
128              
129             __END__