line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WebService::Pingboard; |
2
|
|
|
|
|
|
|
# ABSTRACT: Interface to Pingboard API |
3
|
2
|
|
|
2
|
|
3024
|
use Moose; |
|
2
|
|
|
|
|
967608
|
|
|
2
|
|
|
|
|
14
|
|
4
|
2
|
|
|
2
|
|
15816
|
use MooseX::Params::Validate; |
|
2
|
|
|
|
|
162886
|
|
|
2
|
|
|
|
|
16
|
|
5
|
2
|
|
|
2
|
|
2404
|
use MooseX::WithCache; |
|
2
|
|
|
|
|
239581
|
|
|
2
|
|
|
|
|
15
|
|
6
|
2
|
|
|
2
|
|
15571
|
use LWP::UserAgent; |
|
2
|
|
|
|
|
123656
|
|
|
2
|
|
|
|
|
72
|
|
7
|
2
|
|
|
2
|
|
19
|
use HTTP::Request; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
54
|
|
8
|
2
|
|
|
2
|
|
11
|
use HTTP::Headers; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
49
|
|
9
|
2
|
|
|
2
|
|
1500
|
use JSON::MaybeXS; |
|
2
|
|
|
|
|
31424
|
|
|
2
|
|
|
|
|
371
|
|
10
|
2
|
|
|
2
|
|
1818
|
use YAML; |
|
2
|
|
|
|
|
16079
|
|
|
2
|
|
|
|
|
127
|
|
11
|
2
|
|
|
2
|
|
3661
|
use Encode; |
|
2
|
|
|
|
|
30017
|
|
|
2
|
|
|
|
|
4281
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = 0.003; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 NAME |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
WebService::Pingboard |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 DESCRIPTION |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
Interaction with Pingboard |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
This module uses MooseX::Log::Log4perl for logging - be sure to initialize! |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=cut |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=over 4 |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=item cache |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
Optional. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Provided by MooseX::WithX - optionally pass a Cache::FileCache object to cache and avoid unnecessary requests |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=cut |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
with "MooseX::Log::Log4perl"; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# Unfortunately it is necessary to define the cache type to be expected here with 'backend' |
43
|
|
|
|
|
|
|
# TODO a way to be more generic with cache backend would be better |
44
|
|
|
|
|
|
|
with 'MooseX::WithCache' => { |
45
|
|
|
|
|
|
|
backend => 'Cache::FileCache', |
46
|
|
|
|
|
|
|
}; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=item access_token |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Required. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=cut |
53
|
|
|
|
|
|
|
has 'access_token' => ( |
54
|
|
|
|
|
|
|
is => 'ro', |
55
|
|
|
|
|
|
|
isa => 'Str', |
56
|
|
|
|
|
|
|
required => 1, |
57
|
|
|
|
|
|
|
); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# TODO Username and password login not working yet |
60
|
|
|
|
|
|
|
=item password |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=cut |
64
|
|
|
|
|
|
|
has 'password' => ( |
65
|
|
|
|
|
|
|
is => 'ro', |
66
|
|
|
|
|
|
|
isa => 'Str', |
67
|
|
|
|
|
|
|
required => 0, |
68
|
|
|
|
|
|
|
); |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item username |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=cut |
74
|
|
|
|
|
|
|
has 'username' => ( |
75
|
|
|
|
|
|
|
is => 'ro', |
76
|
|
|
|
|
|
|
isa => 'Str', |
77
|
|
|
|
|
|
|
required => 0, |
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=item timeout |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Timeout when communicating with Pingboard in seconds. Optional. Default: 10 |
83
|
|
|
|
|
|
|
Will only be in effect if you allow the useragent to be built in this module. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=cut |
86
|
|
|
|
|
|
|
has 'timeout' => ( |
87
|
|
|
|
|
|
|
is => 'ro', |
88
|
|
|
|
|
|
|
isa => 'Int', |
89
|
|
|
|
|
|
|
required => 1, |
90
|
|
|
|
|
|
|
default => 10, |
91
|
|
|
|
|
|
|
); |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=item default_backoff |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Optional. Default: 10 |
96
|
|
|
|
|
|
|
Time in seconds to back off before retrying request. |
97
|
|
|
|
|
|
|
If a 429 response is given and the Retry-Time header is provided by the api this will be overridden. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=cut |
100
|
|
|
|
|
|
|
has 'default_backoff' => ( |
101
|
|
|
|
|
|
|
is => 'ro', |
102
|
|
|
|
|
|
|
isa => 'Int', |
103
|
|
|
|
|
|
|
required => 1, |
104
|
|
|
|
|
|
|
default => 10, |
105
|
|
|
|
|
|
|
); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=item default_page_size |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Optional. Default: 100 |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=cut |
112
|
|
|
|
|
|
|
has 'default_page_size' => ( |
113
|
|
|
|
|
|
|
is => 'rw', |
114
|
|
|
|
|
|
|
isa => 'Int', |
115
|
|
|
|
|
|
|
required => 1, |
116
|
|
|
|
|
|
|
default => 100, |
117
|
|
|
|
|
|
|
); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=item retry_on_status |
120
|
|
|
|
|
|
|
Optional. Default: [ 429, 500, 502, 503, 504 ] |
121
|
|
|
|
|
|
|
Which http response codes should we retry on? |
122
|
|
|
|
|
|
|
=cut |
123
|
|
|
|
|
|
|
has 'retry_on_status' => ( |
124
|
|
|
|
|
|
|
is => 'ro', |
125
|
|
|
|
|
|
|
isa => 'ArrayRef', |
126
|
|
|
|
|
|
|
required => 1, |
127
|
|
|
|
|
|
|
default => sub{ [ 429, 500, 502, 503, 504 ] }, |
128
|
|
|
|
|
|
|
); |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item max_tries |
131
|
|
|
|
|
|
|
Optional. Default: undef |
132
|
|
|
|
|
|
|
Limit maximum number of times a query should be attempted before failing. If undefined then unlimited retries |
133
|
|
|
|
|
|
|
=cut |
134
|
|
|
|
|
|
|
has 'max_tries' => ( |
135
|
|
|
|
|
|
|
is => 'ro', |
136
|
|
|
|
|
|
|
isa => 'Int', |
137
|
|
|
|
|
|
|
); |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=item api_url |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
Required. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=cut |
144
|
|
|
|
|
|
|
has 'api_url' => ( |
145
|
|
|
|
|
|
|
is => 'ro', |
146
|
|
|
|
|
|
|
isa => 'Str', |
147
|
|
|
|
|
|
|
required => 1, |
148
|
|
|
|
|
|
|
default => 'https://app.pingboard.com/api/v2/', |
149
|
|
|
|
|
|
|
); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=item user_agent |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Optional. A new LWP::UserAgent will be created for you if you don't already have one you'd like to reuse. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=cut |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
has 'user_agent' => ( |
158
|
|
|
|
|
|
|
is => 'ro', |
159
|
|
|
|
|
|
|
isa => 'LWP::UserAgent', |
160
|
|
|
|
|
|
|
required => 1, |
161
|
|
|
|
|
|
|
lazy => 1, |
162
|
|
|
|
|
|
|
builder => '_build_user_agent', |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
has 'default_headers' => ( |
167
|
|
|
|
|
|
|
is => 'ro', |
168
|
|
|
|
|
|
|
isa => 'HTTP::Headers', |
169
|
|
|
|
|
|
|
required => 1, |
170
|
|
|
|
|
|
|
lazy => 1, |
171
|
|
|
|
|
|
|
builder => '_build_default_headers', |
172
|
|
|
|
|
|
|
); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub _build_user_agent { |
175
|
0
|
|
|
0
|
|
|
my $self = shift; |
176
|
0
|
|
|
|
|
|
$self->log->debug( "Building useragent" ); |
177
|
0
|
|
|
|
|
|
my $ua = LWP::UserAgent->new( |
178
|
|
|
|
|
|
|
keep_alive => 1, |
179
|
|
|
|
|
|
|
timeout => $self->timeout, |
180
|
|
|
|
|
|
|
); |
181
|
0
|
|
|
|
|
|
return $ua; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub _build_default_headers { |
185
|
0
|
|
|
0
|
|
|
my $self = shift; |
186
|
0
|
|
|
|
|
|
my $h = HTTP::Headers->new(); |
187
|
0
|
|
|
|
|
|
$h->header( 'Content-Type' => "application/json" ); |
188
|
0
|
|
|
|
|
|
$h->header( 'Accept' => "application/json" ); |
189
|
|
|
|
|
|
|
# Only oauth works for now |
190
|
0
|
|
|
|
|
|
$h->header( 'Authorization' => "Bearer " . $self->access_token ); |
191
|
0
|
|
|
|
|
|
return $h; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=back |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head1 METHODS |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=over 4 |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=item init |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
Create the user agent. As these are built lazily, initialising manually can avoid |
204
|
|
|
|
|
|
|
errors thrown when building them later being silently swallowed in try/catch blocks. |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=cut |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub init { |
209
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
210
|
0
|
|
|
|
|
|
my $ua = $self->user_agent; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=item get_users |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=over 4 |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=item id |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
The user id to get |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=cut |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub get_users { |
224
|
0
|
|
|
0
|
1
|
|
my ( $self, %params ) = validated_hash( |
225
|
|
|
|
|
|
|
\@_, |
226
|
|
|
|
|
|
|
id => { isa => 'Int', optional => 1 }, |
227
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
228
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
229
|
|
|
|
|
|
|
); |
230
|
0
|
|
|
|
|
|
$params{field} = 'users'; |
231
|
0
|
0
|
|
|
|
|
$params{path} = 'users' . ( $params{id} ? '/' . $params{id} : '' ); |
232
|
0
|
|
|
|
|
|
delete( $params{id} ); |
233
|
0
|
|
|
|
|
|
return $self->_paged_request_from_api( %params ); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=item get_groups |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=over 4 |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=item id (optional) |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
The group id to get |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=cut |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
sub get_groups { |
247
|
0
|
|
|
0
|
1
|
|
my ( $self, %params ) = validated_hash( |
248
|
|
|
|
|
|
|
\@_, |
249
|
|
|
|
|
|
|
id => { isa => 'Int', optional => 1 }, |
250
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
251
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
252
|
|
|
|
|
|
|
); |
253
|
0
|
|
|
|
|
|
$params{field} = 'groups'; |
254
|
0
|
0
|
|
|
|
|
$params{path} = 'groups' . ( $params{id} ? '/' . $params{id} : '' ); |
255
|
0
|
|
|
|
|
|
delete( $params{id} ); |
256
|
0
|
|
|
|
|
|
return $self->_paged_request_from_api( %params ); |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=item get_custom_fields |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=over 4 |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=item id (optional) |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
The resource id to get |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=cut |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
sub get_custom_fields { |
270
|
0
|
|
|
0
|
1
|
|
my ( $self, %params ) = validated_hash( |
271
|
|
|
|
|
|
|
\@_, |
272
|
|
|
|
|
|
|
id => { isa => 'Int', optional => 1 }, |
273
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
274
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
275
|
|
|
|
|
|
|
); |
276
|
0
|
|
|
|
|
|
$params{field} = 'custom_fields'; |
277
|
0
|
0
|
|
|
|
|
$params{path} = 'custom_fields' . ( $params{id} ? '/' . $params{id} : '' ); |
278
|
0
|
|
|
|
|
|
delete( $params{id} ); |
279
|
0
|
|
|
|
|
|
return $self->_paged_request_from_api( %params ); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=item get_linked_accounts |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=over 4 |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=item id |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
The resource id to get |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=cut |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub get_linked_accounts { |
293
|
0
|
|
|
0
|
1
|
|
my ( $self, %params ) = validated_hash( |
294
|
|
|
|
|
|
|
\@_, |
295
|
|
|
|
|
|
|
id => { isa => 'Int'}, |
296
|
|
|
|
|
|
|
); |
297
|
0
|
|
|
|
|
|
$params{field} = 'linked_accounts'; |
298
|
0
|
|
|
|
|
|
$params{path} = 'linked_accounts/' . $params{id}; |
299
|
0
|
|
|
|
|
|
delete( $params{id} ); |
300
|
0
|
|
|
|
|
|
return $self->_paged_request_from_api( %params ); |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=item get_linked_account_providers |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=over 4 |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=item id (optional) |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
The resource id to get |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=cut |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
sub get_linked_account_providers { |
314
|
0
|
|
|
0
|
1
|
|
my ( $self, %params ) = validated_hash( |
315
|
|
|
|
|
|
|
\@_, |
316
|
|
|
|
|
|
|
id => { isa => 'Int', optional => 1 }, |
317
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
318
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
319
|
|
|
|
|
|
|
); |
320
|
0
|
|
|
|
|
|
$params{field} = 'linked_account_providers'; |
321
|
0
|
0
|
|
|
|
|
$params{path} = 'linked_account_providers' . ( $params{id} ? '/' . $params{id} : '' ); |
322
|
0
|
|
|
|
|
|
delete( $params{id} ); |
323
|
0
|
|
|
|
|
|
return $self->_paged_request_from_api( %params ); |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=item get_statuses |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=over 4 |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=item id (optional) |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
The resource id to get |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=cut |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub get_statuses { |
337
|
0
|
|
|
0
|
1
|
|
my ( $self, %params ) = validated_hash( |
338
|
|
|
|
|
|
|
\@_, |
339
|
|
|
|
|
|
|
id => { isa => 'Int', optional => 1 }, |
340
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
341
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
342
|
|
|
|
|
|
|
); |
343
|
0
|
|
|
|
|
|
$params{field} = 'statuses'; |
344
|
0
|
0
|
|
|
|
|
$params{path} = 'statuses' . ( $params{id} ? '/' . $params{id} : '' ); |
345
|
0
|
|
|
|
|
|
delete( $params{id} ); |
346
|
0
|
|
|
|
|
|
return $self->_paged_request_from_api( %params ); |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=item clear_cache_object_id |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Clears an object from the cache. |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=over 4 |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=item user_id |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
Required. Object id to clear from the cache. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=back |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
Returns whether cache_del was successful or not |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=cut |
365
|
|
|
|
|
|
|
sub clear_cache_object_id { |
366
|
0
|
|
|
0
|
1
|
|
my ( $self, %params ) = validated_hash( |
367
|
|
|
|
|
|
|
\@_, |
368
|
|
|
|
|
|
|
object_id => { isa => 'Str' } |
369
|
|
|
|
|
|
|
); |
370
|
|
|
|
|
|
|
|
371
|
0
|
|
|
|
|
|
$self->log->debug( "Clearing cache id: $params{object_id}" ); |
372
|
0
|
|
|
|
|
|
my $foo = $self->cache_del( $params{object_id} ); |
373
|
|
|
|
|
|
|
|
374
|
0
|
|
|
|
|
|
return $foo; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub _paged_request_from_api { |
378
|
0
|
|
|
0
|
|
|
my ( $self, %params ) = validated_hash( |
379
|
|
|
|
|
|
|
\@_, |
380
|
|
|
|
|
|
|
method => { isa => 'Str', optional => 1, default => 'GET' }, |
381
|
|
|
|
|
|
|
path => { isa => 'Str' }, |
382
|
|
|
|
|
|
|
field => { isa => 'Str' }, |
383
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
384
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
385
|
|
|
|
|
|
|
body => { isa => 'Str', optional => 1 }, |
386
|
|
|
|
|
|
|
); |
387
|
0
|
|
|
|
|
|
my @results; |
388
|
0
|
|
|
|
|
|
my $page = 1; |
389
|
|
|
|
|
|
|
|
390
|
0
|
|
0
|
|
|
|
$params{page_size} ||= $self->default_page_size; |
391
|
0
|
0
|
0
|
|
|
|
if( $params{limit} and $params{limit} < $params{page_size} ){ |
392
|
0
|
|
|
|
|
|
$params{page_size} = $params{limit}; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
0
|
|
|
|
|
|
my $response = undef; |
396
|
|
|
|
|
|
|
do{ |
397
|
|
|
|
|
|
|
$response = $self->_request_from_api( |
398
|
|
|
|
|
|
|
method => $params{method}, |
399
|
|
|
|
|
|
|
path => $params{path} . ( $params{path} =~ m/\?/ ? '&' : '?' ) . 'page=' . $page . '&page_size=' . $params{page_size}, |
400
|
0
|
0
|
|
|
|
|
); |
401
|
0
|
|
|
|
|
|
push( @results, @{ $response->{$params{field} } } ); |
|
0
|
|
|
|
|
|
|
402
|
0
|
|
|
|
|
|
$page++; |
403
|
0
|
|
0
|
|
|
|
}while( $response->{meta}{$params{field}}{page} < $response->{meta}{$params{field}}{page_count} and ( not $params{limit} or scalar( @results ) < $params{limit} ) ); |
|
|
|
0
|
|
|
|
|
404
|
0
|
|
|
|
|
|
return @results; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub _request_from_api { |
409
|
0
|
|
|
0
|
|
|
my ( $self, %params ) = validated_hash( |
410
|
|
|
|
|
|
|
\@_, |
411
|
|
|
|
|
|
|
method => { isa => 'Str' }, |
412
|
|
|
|
|
|
|
path => { isa => 'Str', optional => 1 }, |
413
|
|
|
|
|
|
|
uri => { isa => 'Str', optional => 1 }, |
414
|
|
|
|
|
|
|
body => { isa => 'Str', optional => 1 }, |
415
|
|
|
|
|
|
|
headers => { isa => 'HTTP::Headers', optional => 1 }, |
416
|
|
|
|
|
|
|
fields => { isa => 'HashRef', optional => 1 }, |
417
|
|
|
|
|
|
|
); |
418
|
0
|
|
|
|
|
|
my $url; |
419
|
0
|
0
|
|
|
|
|
if( $params{uri} ){ |
|
|
0
|
|
|
|
|
|
420
|
0
|
|
|
|
|
|
$url = $params{uri}; |
421
|
|
|
|
|
|
|
}elsif( $params{path} ){ |
422
|
0
|
|
|
|
|
|
$url = $self->api_url . $params{path}; |
423
|
|
|
|
|
|
|
}else{ |
424
|
0
|
|
|
|
|
|
$self->log->logdie( "Cannot request without either a path or uri" ); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
my $request = HTTP::Request->new( |
428
|
|
|
|
|
|
|
$params{method}, |
429
|
|
|
|
|
|
|
$url, |
430
|
0
|
|
0
|
|
|
|
$params{headers} || $self->default_headers, |
431
|
|
|
|
|
|
|
); |
432
|
0
|
0
|
|
|
|
|
$request->content( $params{body} ) if( $params{body} ); |
433
|
|
|
|
|
|
|
|
434
|
0
|
|
|
|
|
|
$self->log->debug( "Requesting: " . $request->uri ); |
435
|
0
|
0
|
|
|
|
|
$self->log->trace( "Request:\n" . Dump( $request ) ) if $self->log->is_trace; |
436
|
|
|
|
|
|
|
|
437
|
0
|
|
|
|
|
|
my $response; |
438
|
0
|
|
|
|
|
|
my $retry = 1; |
439
|
0
|
|
|
|
|
|
my $try_count = 0; |
440
|
0
|
|
|
|
|
|
do{ |
441
|
0
|
|
|
|
|
|
my $retry_delay = $self->default_backoff; |
442
|
0
|
|
|
|
|
|
$try_count++; |
443
|
|
|
|
|
|
|
# Fields are a special use-case for GET requests: |
444
|
|
|
|
|
|
|
# https://metacpan.org/pod/LWP::UserAgent#ua-get-url-field_name-value |
445
|
0
|
0
|
|
|
|
|
if( $params{fields} ){ |
446
|
0
|
0
|
|
|
|
|
if( $request->method ne 'GET' ){ |
447
|
0
|
|
|
|
|
|
$self->log->logdie( 'Cannot use fields unless the request method is GET' ); |
448
|
|
|
|
|
|
|
} |
449
|
0
|
|
|
|
|
|
my %fields = %{ $params{fields} }; |
|
0
|
|
|
|
|
|
|
450
|
0
|
|
|
|
|
|
my $headers = $request->headers(); |
451
|
0
|
|
|
|
|
|
foreach( keys( %{ $headers } ) ){ |
|
0
|
|
|
|
|
|
|
452
|
0
|
|
|
|
|
|
$fields{$_} = $headers->{$_}; |
453
|
|
|
|
|
|
|
} |
454
|
0
|
|
|
|
|
|
$self->log->trace( "Fields:\n" . Dump( \%fields ) ); |
455
|
0
|
|
|
|
|
|
$response = $self->user_agent->get( |
456
|
|
|
|
|
|
|
$request->uri(), |
457
|
|
|
|
|
|
|
%fields, |
458
|
|
|
|
|
|
|
); |
459
|
|
|
|
|
|
|
}else{ |
460
|
0
|
|
|
|
|
|
$response = $self->user_agent->request( $request ); |
461
|
|
|
|
|
|
|
} |
462
|
0
|
0
|
|
|
|
|
if( $response->is_success ){ |
463
|
0
|
|
|
|
|
|
$retry = 0; |
464
|
|
|
|
|
|
|
}else{ |
465
|
0
|
0
|
|
|
|
|
if( grep{ $_ == $response->code } @{ $self->retry_on_status } ){ |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
466
|
0
|
0
|
|
|
|
|
if( $response->code == 429 ){ |
467
|
|
|
|
|
|
|
# if retry-after header exists and has valid data use this for backoff time |
468
|
0
|
0
|
0
|
|
|
|
if( $response->header( 'Retry-After' ) and $response->header('Retry-After') =~ /^\d+$/ ) { |
469
|
0
|
|
|
|
|
|
$retry_delay = $response->header('Retry-After'); |
470
|
|
|
|
|
|
|
} |
471
|
0
|
|
|
|
|
|
$self->log->warn( sprintf( "Received a %u (Too Many Requests) response with 'Retry-After' header... going to backoff and retry in %u seconds!", |
472
|
|
|
|
|
|
|
$response->code, |
473
|
|
|
|
|
|
|
$retry_delay, |
474
|
|
|
|
|
|
|
) ); |
475
|
|
|
|
|
|
|
}else{ |
476
|
0
|
|
|
|
|
|
$self->log->warn( sprintf( "Received a %u: %s ... going to backoff and retry in %u seconds!", |
477
|
|
|
|
|
|
|
$response->code, |
478
|
|
|
|
|
|
|
$response->decoded_content, |
479
|
|
|
|
|
|
|
$retry_delay |
480
|
|
|
|
|
|
|
) ); |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
}else{ |
483
|
0
|
|
|
|
|
|
$retry = 0; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
0
|
0
|
|
|
|
|
if( $retry == 1 ){ |
487
|
0
|
0
|
0
|
|
|
|
if( not $self->max_tries or $self->max_tries > $try_count ){ |
488
|
0
|
|
|
|
|
|
$self->log->debug( sprintf( "Try %u failed... sleeping %u before next attempt", $try_count, $retry_delay ) ); |
489
|
0
|
|
|
|
|
|
sleep( $retry_delay ); |
490
|
|
|
|
|
|
|
}else{ |
491
|
0
|
|
|
|
|
|
$self->log->debug( sprintf( "Try %u failed... exceeded max_tries (%u) so not going to retry", $try_count, $self->max_tries ) ); |
492
|
0
|
|
|
|
|
|
$retry = 0; |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
}while( $retry ); |
497
|
|
|
|
|
|
|
|
498
|
0
|
0
|
|
|
|
|
$self->log->trace( "Last response:\n", Dump( $response ) ) if $self->log->is_trace; |
499
|
0
|
0
|
|
|
|
|
if( not $response->is_success ){ |
500
|
0
|
|
|
|
|
|
$self->log->logdie( "API Error: http status:". $response->code .' '. $response->message . ' Content: ' . $response->content); |
501
|
|
|
|
|
|
|
} |
502
|
0
|
0
|
|
|
|
|
if( $response->decoded_content ){ |
503
|
0
|
|
|
|
|
|
return decode_json( encode( 'utf8', $response->decoded_content ) ); |
504
|
|
|
|
|
|
|
} |
505
|
0
|
|
|
|
|
|
return; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
1; |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=back |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=head1 COPYRIGHT |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
Copyright 2015, Robin Clarke |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=head1 AUTHOR |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
Robin Clarke <robin@robinclarke.net> |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
Jeremy Falling <projects@falling.se> |
522
|
|
|
|
|
|
|
|