File Coverage

blib/lib/Google/Client/Role/FurlAgent.pm
Criterion Covered Total %
statement 37 37 100.0
branch 8 8 100.0
condition 2 2 100.0
subroutine 9 9 100.0
pod n/a
total 56 56 100.0


line stmt bran cond sub pod time code
1             package Google::Client::Role::FurlAgent;
2             $Google::Client::Role::FurlAgent::VERSION = '0.004';
3 17     17   6645 use strict;
  17         19  
  17         395  
4 17     17   51 use warnings;
  17         17  
  17         307  
5              
6 17     17   48 use Moo::Role;
  17         16  
  17         66  
7              
8 17     17   3546 use Carp;
  17         21  
  17         761  
9 17     17   58 use Cpanel::JSON::XS;
  17         21  
  17         686  
10 17     17   1194 use Furl;
  17         47304  
  17         347  
11 17     17   7448 use URI;
  17         50853  
  17         3635  
12              
13             has ua => (
14             is => 'ro',
15             default => sub { return Furl->new(); }
16             );
17              
18             # Hook that checks if an access token is available before
19             # making API requests. Will die with error if not found.
20              
21             # It would be wise to store the access token in a cache
22             # which expires in the 'expires_in' seconds returned
23             # by Google with the token, that way you will know
24             # when to refresh it or request a new one.
25              
26             before _request => sub {
27             my $self = shift;
28              
29             unless ( $self->access_token ) {
30             confess('access token not found or may have expired');
31             }
32             };
33              
34             # Performs a request with the given parameters. These should be the same parameters
35             # accepted by L. Returns the responses
36             # JSON.
37             # Will add an Authorization header with the access_token attributes value to the request.
38             # Can die with an error if the response code was not a successful one, or if there was
39             # an error decoding the JSON data. For requests that do not return any content, will
40             # just return undef to indicate we have received no content.
41              
42             sub _request {
43 15     15   1515 my ($self, %req) = @_;
44              
45 15         233 $req{headers} = ['Authorization', 'Bearer '.$self->access_token];
46 15         973 my $response = $self->ua->request(%req);
47              
48 15 100       1074 unless ( $response->is_success ) {
49 1         32 confess("Google API request failed: \n\n" . $response->as_string);
50             }
51              
52 14 100       555 return unless ( $response->decoded_content );
53              
54 12         368 my $json = eval { decode_json($response->decoded_content); };
  12         44  
55 12 100       612 confess("Error decoding JSON: $@") if $@;
56              
57 11         49 return $json;
58             }
59              
60             sub _url {
61 12     12   22 my ($self, $uri, $params) = @_;
62 12   100     46 $uri ||= '';
63 12         94 my $url = URI->new($self->base_url . $uri);
64 12 100       65688 if ( $params ) {
65 9         63 $url->query_form($params);
66             }
67 12         805 return $url->as_string;
68             }
69              
70             =head1 NAME
71              
72             Google::Client::Role::FurlAgent
73              
74             =head1 DESCRIPTION
75              
76             A Furl useragent used to make requests to Googles REST API and do other helpful
77             tasks such as building URLs and return JSON content.
78              
79             Used by the Google::Client::* modules
80              
81             =head1 AUTHOR
82              
83             Ali Zia, C<< >>
84              
85             =head1 REPOSITORY
86              
87             L
88              
89             =head1 COPYRIGHT AND LICENSE
90              
91             This is free software. You may use it and distribute it under the same terms as Perl itself.
92             Copyright (C) 2016 - Ali Zia
93              
94             =cut
95              
96             1;