line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
3
|
|
|
3
|
|
36
|
use strictures; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
28
|
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package WebService::GoogleAPI::Client::UserAgent; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.26'; # VERSION |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
# ABSTRACT: User Agent wrapper for working with Google APIs |
8
|
|
|
|
|
|
|
|
9
|
3
|
|
|
3
|
|
585
|
use Moo; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
27
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
extends 'Mojo::UserAgent'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
#extends 'Mojo::UserAgent::Mockable'; |
14
|
3
|
|
|
3
|
|
1002
|
use WebService::GoogleAPI::Client::AuthStorage::GapiJSON; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
90
|
|
15
|
3
|
|
|
3
|
|
1732
|
use Mojo::UserAgent; |
|
3
|
|
|
|
|
621379
|
|
|
3
|
|
|
|
|
28
|
|
16
|
3
|
|
|
3
|
|
159
|
use Data::Dump qw/pp/; # for dev debug |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
173
|
|
17
|
|
|
|
|
|
|
|
18
|
3
|
|
|
3
|
|
18
|
use Carp qw/croak carp cluck/; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
3170
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
has 'do_autorefresh' => (is => 'rw', default => 1); |
21
|
|
|
|
|
|
|
has 'debug' => (is => 'rw', default => 0); |
22
|
|
|
|
|
|
|
has 'auth_storage' => ( |
23
|
|
|
|
|
|
|
is => 'rw', |
24
|
|
|
|
|
|
|
default => sub { |
25
|
|
|
|
|
|
|
WebService::GoogleAPI::Client::AuthStorage::GapiJSON->new; |
26
|
|
|
|
|
|
|
}, |
27
|
|
|
|
|
|
|
handles => [qw/get_access_token scopes user/], |
28
|
|
|
|
|
|
|
trigger => 1, |
29
|
|
|
|
|
|
|
isa => sub { |
30
|
|
|
|
|
|
|
my $role = 'WebService::GoogleAPI::Client::AuthStorage'; |
31
|
|
|
|
|
|
|
die "auth_storage must implement the $role role to work!" |
32
|
|
|
|
|
|
|
unless $_[0]->does($role); |
33
|
|
|
|
|
|
|
}, |
34
|
|
|
|
|
|
|
lazy => 1 |
35
|
|
|
|
|
|
|
); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub _trigger_auth_storage { |
38
|
3
|
|
|
3
|
|
324
|
my ($self) = @_; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# give the auth_storage a ua |
41
|
|
|
|
|
|
|
# TODO - this seems like code smell to me. Should these storage things be |
42
|
|
|
|
|
|
|
# roles that get applied to this ua? |
43
|
3
|
|
|
|
|
64
|
$self->auth_storage->ua($self); |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
## NB - could cache using https://metacpan.org/pod/Mojo::UserAgent::Cached |
47
|
|
|
|
|
|
|
# TODO: Review source of this for ideas |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
## NB - used by both Client and Discovery |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# Keep access_token in headers always actual |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
## performance tip as per https://developers.google.com/calendar/performance and similar links |
55
|
|
|
|
|
|
|
## NB - to work with Google APIs also assumes that Accept-Encoding: gzip is set in HTTP headers |
56
|
|
|
|
|
|
|
sub BUILD { |
57
|
4
|
|
|
4
|
0
|
5273
|
my ($self) = @_; |
58
|
4
|
|
|
|
|
35
|
$self->transactor->name(__PACKAGE__ . ' (gzip enabled)'); |
59
|
|
|
|
|
|
|
## MAX SIZE ETC _ WHAT OTHER CONFIGURABLE PARAMS ARE AVAILABLE |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub header_with_bearer_auth_token { |
65
|
1
|
|
|
1
|
1
|
3
|
my ($self, $headers) = @_; |
66
|
|
|
|
|
|
|
|
67
|
1
|
50
|
|
|
|
4
|
$headers = {} unless defined $headers; |
68
|
|
|
|
|
|
|
|
69
|
1
|
|
|
|
|
4
|
$headers->{'Accept-Encoding'} = 'gzip'; |
70
|
|
|
|
|
|
|
|
71
|
1
|
50
|
|
|
|
21
|
if (my $token = $self->get_access_token) { |
72
|
1
|
|
|
|
|
4
|
$headers->{Authorization} = "Bearer $token"; |
73
|
|
|
|
|
|
|
} else { |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# TODO - why is this not fatal? |
76
|
0
|
|
|
|
|
0
|
carp |
77
|
|
|
|
|
|
|
"Can't build Auth header, couldn't get an access token. Is your AuthStorage set up correctly?"; |
78
|
|
|
|
|
|
|
} |
79
|
1
|
|
|
|
|
8
|
return $headers; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub build_http_transaction { |
84
|
1
|
|
|
1
|
1
|
3
|
my ($self, $params) = @_; |
85
|
|
|
|
|
|
|
## hack to allow method option as alias for httpMethod |
86
|
|
|
|
|
|
|
|
87
|
1
|
50
|
|
|
|
6
|
$params->{httpMethod} = $params->{method} if defined $params->{method}; |
88
|
1
|
50
|
|
|
|
4
|
$params->{httpMethod} = '' unless defined $params->{httpMethod}; |
89
|
|
|
|
|
|
|
|
90
|
1
|
|
50
|
|
|
5
|
my $http_method = uc($params->{httpMethod}) || 'GET'; # uppercase ? |
91
|
1
|
|
50
|
|
|
4
|
my $optional_data = $params->{options} || ''; |
92
|
|
|
|
|
|
|
my $path = $params->{path} |
93
|
1
|
|
33
|
|
|
4
|
|| cluck('path parameter required for build_http_transaction'); |
94
|
|
|
|
|
|
|
my $no_auth = $params->{no_auth} |
95
|
1
|
|
50
|
|
|
4
|
|| 0; ## default to including auth header - ie not setting no_auth |
96
|
1
|
|
50
|
|
|
6
|
my $headers = $params->{headers} || {}; |
97
|
|
|
|
|
|
|
|
98
|
1
|
50
|
33
|
|
|
6
|
cluck 'Attention! You are using POST, but no payload specified' |
99
|
|
|
|
|
|
|
if (($http_method eq 'POST') && !defined $optional_data); |
100
|
1
|
50
|
|
|
|
5
|
cluck "build_http_transaction:: $http_method $path " if ($self->debug > 11); |
101
|
1
|
50
|
|
|
|
6
|
cluck |
102
|
|
|
|
|
|
|
"$http_method Not a SUPPORTED HTTP method parameter specified to build_http_transaction" |
103
|
|
|
|
|
|
|
. pp $params |
104
|
|
|
|
|
|
|
unless $http_method =~ /^GET|PATH|PUT|POST|PATCH|DELETE$/ixm; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
## NB - headers not passed if no_auth |
107
|
1
|
50
|
|
|
|
6
|
$headers = $self->header_with_bearer_auth_token($headers) unless $no_auth; |
108
|
1
|
50
|
|
|
|
6
|
if ($http_method =~ /^POST|PATH|PUT|PATCH$/ixg) { |
109
|
|
|
|
|
|
|
## ternary conditional on whether optional_data is set |
110
|
|
|
|
|
|
|
## return $optional_data eq '' ? $self->build_tx( $http_method => $path => $headers ) : $self->build_tx( $http_method => $path => $headers => json => $optional_data ); |
111
|
0
|
0
|
|
|
|
0
|
if ($optional_data eq '') { |
112
|
0
|
|
|
|
|
0
|
return $self->build_tx($http_method => $path => $headers); |
113
|
|
|
|
|
|
|
} else { |
114
|
0
|
0
|
|
|
|
0
|
if (ref($optional_data) eq 'HASH') { |
|
|
0
|
|
|
|
|
|
115
|
0
|
|
|
|
|
0
|
return $self->build_tx( |
116
|
|
|
|
|
|
|
$http_method => $path => $headers => json => $optional_data); |
117
|
|
|
|
|
|
|
} elsif ( |
118
|
|
|
|
|
|
|
ref($optional_data) eq |
119
|
|
|
|
|
|
|
'') ## am assuming is a post with options containing a binary payload |
120
|
|
|
|
|
|
|
{ |
121
|
0
|
|
|
|
|
0
|
return $self->build_tx( |
122
|
|
|
|
|
|
|
$http_method => $path => $headers => $optional_data); |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
} else { ## DELETE or GET |
127
|
1
|
50
|
|
|
|
11
|
return $self->build_tx( |
128
|
|
|
|
|
|
|
$http_method => $path => $headers => form => $optional_data) |
129
|
|
|
|
|
|
|
if ($http_method eq 'GET'); |
130
|
0
|
0
|
|
|
|
0
|
return $self->build_tx($http_method => $path => $headers) |
131
|
|
|
|
|
|
|
if ($http_method eq 'DELETE'); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
#return undef; ## assert: should never get here |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# NOTE validated means that we assume checking against discovery specs has already been done. |
141
|
|
|
|
|
|
|
sub validated_api_query { |
142
|
1
|
|
|
1
|
1
|
3
|
my ($self, $params) = @_; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
## assume is a GET for the URI at $params |
145
|
1
|
50
|
|
|
|
7
|
if (ref($params) eq '') { |
146
|
1
|
50
|
|
|
|
5
|
cluck("transcribing $params to a hashref for validated_api_query") |
147
|
|
|
|
|
|
|
if $self->debug; |
148
|
1
|
|
|
|
|
3
|
my $val = $params; |
149
|
1
|
|
|
|
|
5
|
$params = { path => $val, method => 'get', options => {}, }; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
1
|
|
|
|
|
7
|
my $tx = $self->build_http_transaction($params); |
153
|
|
|
|
|
|
|
|
154
|
1
|
50
|
|
|
|
430
|
cluck("$params->{method} $params->{path}") if $self->debug; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
#TODO- figure out how we can alter this to use promises |
157
|
|
|
|
|
|
|
# at this point, i think we'd have to make a different method entirely to |
158
|
|
|
|
|
|
|
# do this promise-wise |
159
|
1
|
|
|
|
|
6
|
my $res = $self->start($tx)->res; |
160
|
1
|
|
|
|
|
188087
|
$res->{_token} = $self->get_access_token; |
161
|
|
|
|
|
|
|
|
162
|
1
|
50
|
33
|
|
|
39
|
if (($res->code == 401) && $self->do_autorefresh) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
163
|
0
|
0
|
|
|
|
0
|
cluck |
164
|
|
|
|
|
|
|
"Your access token was expired. Attemptimg to update it automatically..." |
165
|
|
|
|
|
|
|
if ($self->debug > 11); |
166
|
|
|
|
|
|
|
|
167
|
0
|
|
|
|
|
0
|
$self->auth_storage->refresh_access_token($self); |
168
|
|
|
|
|
|
|
|
169
|
0
|
|
|
|
|
0
|
return $self->validated_api_query($params); |
170
|
|
|
|
|
|
|
} elsif ($res->code == 403) { |
171
|
0
|
|
|
|
|
0
|
cluck('Unexpected permission denied 403 error'); |
172
|
0
|
|
|
|
|
0
|
return $res; |
173
|
|
|
|
|
|
|
} elsif ($res->code == 429) { |
174
|
0
|
|
|
|
|
0
|
cluck('HTTP 429 - you hit a rate limit. Try again later'); |
175
|
0
|
|
|
|
|
0
|
return $res; |
176
|
|
|
|
|
|
|
} |
177
|
1
|
50
|
|
|
|
24
|
return $res if $res->code == 200; |
178
|
0
|
0
|
|
|
|
|
return $res if $res->code == 204; ## NO CONTENT - INDICATES OK FOR DELETE ETC |
179
|
0
|
0
|
|
|
|
|
return $res if $res->code == 400; ## general failure |
180
|
0
|
|
|
|
|
|
cluck("unhandled validated_api_query response code " . $res->code); |
181
|
0
|
|
|
|
|
|
return $res; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
1; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
__END__ |