File Coverage

blib/lib/Net/Google/Storage/Agent.pm
Criterion Covered Total %
statement 18 64 28.1
branch 0 8 0.0
condition n/a
subroutine 6 15 40.0
pod 1 1 100.0
total 25 88 28.4


line stmt bran cond sub pod time code
1 1     1   807 use strict;
  1         3  
  1         33  
2 1     1   5 use warnings;
  1         2  
  1         61  
3             package Net::Google::Storage::Agent;
4             $Net::Google::Storage::Agent::VERSION = '0.2.0';
5             # ABSTRACT: Access the Google Storage JSON API (currently experimental).
6             # https://developers.google.com/storage/docs/json_api/
7              
8 1     1   408 use Moose::Role;
  1         4811  
  1         6  
9 1     1   5471 use LWP::UserAgent 6.04;
  1         30  
  1         19  
10 1     1   6 use JSON;
  1         3  
  1         9  
11 1     1   126 use URI::Escape 3.29;
  1         20  
  1         650  
12              
13              
14             has access_token => (
15             is => 'rw',
16             isa => 'Str',
17             );
18              
19              
20             has refresh_token => (
21             is => 'ro',
22             isa => 'Str',
23             );
24              
25              
26             has client_id => (
27             is => 'ro',
28             isa => 'Str',
29             );
30              
31              
32             has client_secret => (
33             is => 'ro',
34             isa => 'Str',
35             );
36              
37              
38             has has_refreshed_access_token => (
39             is => 'rw',
40             isa => 'Bool',
41             default => 0,
42             );
43              
44              
45             has access_token_expiry => (
46             is => 'rw',
47             isa => 'Int',
48             );
49              
50             has _ua => (
51             is => 'ro',
52             isa => 'LWP::UserAgent',
53             lazy => 1,
54             builder => '_build_ua',
55             );
56              
57             sub _build_ua
58             {
59 0     0     my $self = shift;
60 0           my $ua = LWP::UserAgent->new(agent => 'Net::Google::Storage ');
61            
62 0           my @encodings = HTTP::Message::decodable;
63 0 0         if(grep {$_ eq 'gzip'} @encodings)
  0            
64             {
65 0           $ua->agent($ua->agent . ' (gzip)');
66 0           $ua->default_header('Accept-Encoding' => join ', ', @encodings);
67             }
68            
69 0           return $ua;
70             }
71              
72             sub _set_auth_header
73             {
74 0     0     my $self = shift;
75 0           my $ua = $self->_ua;
76            
77 0 0         if($self->access_token)
    0          
78             {
79 0           $ua->default_header(Authorization => "OAuth " . $self->access_token);
80             }
81             elsif($self->refresh_token)
82             {
83 0           $self->refresh_access_token
84             }
85             }
86              
87              
88             sub refresh_access_token
89             {
90 0     0 1   my $self = shift;
91            
92 0           my $ua = $self->_ua;
93 0           my $res = $ua->post('https://accounts.google.com/o/oauth2/token', {
94             client_id => $self->client_id,
95             client_secret => $self->client_secret,
96             refresh_token => $self->refresh_token,
97             grant_type => 'refresh_token',
98             });
99            
100 0 0         die 'Failed to refresh the access token' . $res->content unless $res->is_success;
101            
102 0           my $response = decode_json($res->decoded_content);
103 0           $self->access_token($response->{access_token});
104 0           $self->access_token_expiry(time + $response->{expires_in});
105 0           $self->has_refreshed_access_token(1);
106 0           $self->_set_auth_header;
107             }
108              
109             sub _get
110             {
111 0     0     my $self = shift;
112 0           my $ua = $self->_ua;
113            
114 0           my $res = $ua->get(@_);
115            
116 0           return $res;
117             }
118              
119             sub _post
120             {
121 0     0     my $self = shift;
122 0           my $ua = $self->_ua;
123            
124 0           my $res = $ua->post(@_);
125 0           return $res;
126             }
127              
128             sub _json_post
129             {
130 0     0     my $self = shift;
131            
132 0           my $args = pop;
133 0           return $self->_post(@_, 'Content-Type' => 'application/json', Content => encode_json($args));
134             }
135              
136             sub _delete
137             {
138 0     0     my $self = shift;
139 0           my $ua = $self->_ua;
140            
141 0           my $res = $ua->delete(@_);
142 0           return $res;
143             }
144              
145             sub _put
146             {
147 0     0     my $self = shift;
148 0           my $ua = $self->_ua;
149            
150 0           my $res = $ua->put(@_);
151 0           return $res;
152             }
153              
154             around [qw(_get _post _delete _put)] => sub {
155             my $orig = shift;
156             my $self = shift;
157            
158             my $ua = $self->_ua;
159             my $expiry = $self->access_token_expiry;
160            
161             if((!$ua->default_header('Authorization')) || ($expiry && $expiry < time))
162             {
163             $self->_set_auth_header;
164             }
165            
166             my $res = $self->$orig(@_);
167             if($res->code == 401 && $self->refresh_token)
168             {
169             $self->refresh_access_token;
170             $res = $self->$orig(@_);
171             }
172            
173             return $res;
174             };
175              
176             sub _form_url
177             {
178 0     0     my $self = shift;
179            
180 0           my $format = shift;
181 0           my @args = map {uri_escape_utf8($_)} @_;
  0            
182            
183 0           return sprintf $format, @args;
184             }
185              
186             1;
187              
188             __END__
189              
190             =pod
191              
192             =encoding UTF-8
193              
194             =head1 NAME
195              
196             Net::Google::Storage::Agent - Access the Google Storage JSON API (currently experimental).
197              
198             =head1 VERSION
199              
200             version 0.2.0
201              
202             =head1 DESCRIPTION
203              
204             Role-module for L<Net::Google::Storage>, handles the http communication side
205             of things.
206              
207             Some or all of the following attributes should be passed in as an argument to
208             L<Net::Google::Storage/new>
209              
210             =head1 ATTRIBUTES
211              
212             =head2 access_token
213              
214             An OAuth2 access token used to actually access the resources.
215              
216             =head2 refresh_token
217              
218             An OAuth2 refresh token used for acquiring a new L</access_tokens> - you
219             don't need both a refresh_token and an access_token, but you'll need at least
220             one of them.
221              
222             =head2 client_id
223              
224             The client ID for the user being authenticated - retrieved from Google's
225             L<API Console|https://code.google.com/apis/console/#access>.
226              
227             Required for refreshing access tokens (ie provide if you are also providing
228             the L</refresh_token>).
229              
230             =head2 client_secret
231              
232             Counterpart to the client ID, also retrieved from the API Console.
233              
234             Again, only required for refreshing access tokens.
235              
236             =head2 access_token_expiry
237              
238             The time (in seconds since the epoch) at which the access_token will be
239             invalidated. Not required, but if supplied with the L</access_token> it
240             B<will> be trusted, and token refresh will be attempted after this time
241             without attempting communication.
242              
243             =head1 METHODS
244              
245             =head2 has_refreshed_access_token
246              
247             Call without parameters to find whether the L</access_token> has been
248             refreshed.
249              
250             Call with a false value to indicate you know about that refresh, so future
251             calls without any parameters will still be useful.
252              
253             =head2 refresh_access_token
254              
255             Call (on the L<Net::Google::Storage> object) to refresh the access token.
256             Requires the C<client_id>, the C<client_secret> and the C<refresh_token> to
257             all be set. Updates the C<access_token>, the C<access_token_expiry> and
258             C<has_refreshed_access_token> will start returning true.
259              
260             =head1 AUTHOR
261              
262             Glenn Fowler <cebjyre@cpan.org>
263              
264             =head1 COPYRIGHT AND LICENSE
265              
266             This software is copyright (c) 2012 by Glenn Fowler.
267              
268             This is free software; you can redistribute it and/or modify it under
269             the same terms as the Perl 5 programming language system itself.
270              
271             =cut