line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WebService::Pingboard; |
2
|
|
|
|
|
|
|
# ABSTRACT: Interface to Pingboard API |
3
|
2
|
|
|
2
|
|
3127
|
use Moose; |
|
2
|
|
|
|
|
937770
|
|
|
2
|
|
|
|
|
13
|
|
4
|
2
|
|
|
2
|
|
15545
|
use MooseX::Params::Validate; |
|
2
|
|
|
|
|
160011
|
|
|
2
|
|
|
|
|
15
|
|
5
|
2
|
|
|
2
|
|
2303
|
use MooseX::WithCache; |
|
2
|
|
|
|
|
231743
|
|
|
2
|
|
|
|
|
16
|
|
6
|
2
|
|
|
2
|
|
6533
|
use LWP::UserAgent; |
|
2
|
|
|
|
|
103859
|
|
|
2
|
|
|
|
|
78
|
|
7
|
2
|
|
|
2
|
|
16
|
use HTTP::Request; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
57
|
|
8
|
2
|
|
|
2
|
|
11
|
use HTTP::Headers; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
49
|
|
9
|
2
|
|
|
2
|
|
1492
|
use JSON::MaybeXS; |
|
2
|
|
|
|
|
53466
|
|
|
2
|
|
|
|
|
171
|
|
10
|
2
|
|
|
2
|
|
1857
|
use YAML; |
|
2
|
|
|
|
|
16515
|
|
|
2
|
|
|
|
|
130
|
|
11
|
2
|
|
|
2
|
|
1771
|
use Encode; |
|
2
|
|
|
|
|
21702
|
|
|
2
|
|
|
|
|
179
|
|
12
|
2
|
|
|
2
|
|
1486
|
use URI::Encode qw/uri_encode/; |
|
2
|
|
|
|
|
2637
|
|
|
2
|
|
|
|
|
5163
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $VERSION = 0.004; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 NAME |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
WebService::Pingboard |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 DESCRIPTION |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Interaction with Pingboard |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
This module uses MooseX::Log::Log4perl for logging - be sure to initialize! |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=cut |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=over 4 |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=item cache |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
Optional. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Provided by MooseX::WithX - optionally pass a Cache::FileCache object to cache and avoid unnecessary requests |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=cut |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
with "MooseX::Log::Log4perl"; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Unfortunately it is necessary to define the cache type to be expected here with 'backend' |
44
|
|
|
|
|
|
|
# TODO a way to be more generic with cache backend would be better |
45
|
|
|
|
|
|
|
with 'MooseX::WithCache' => { |
46
|
|
|
|
|
|
|
backend => 'Cache::FileCache', |
47
|
|
|
|
|
|
|
}; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=item refresh_token |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=cut |
53
|
|
|
|
|
|
|
has 'refresh_token' => ( |
54
|
|
|
|
|
|
|
is => 'ro', |
55
|
|
|
|
|
|
|
isa => 'Str', |
56
|
|
|
|
|
|
|
required => 0, |
57
|
|
|
|
|
|
|
writer => '_set_refresh_token', |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=item password |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=cut |
64
|
|
|
|
|
|
|
has 'password' => ( |
65
|
|
|
|
|
|
|
is => 'ro', |
66
|
|
|
|
|
|
|
isa => 'Str', |
67
|
|
|
|
|
|
|
required => 0, |
68
|
|
|
|
|
|
|
writer => '_set_password', |
69
|
|
|
|
|
|
|
); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=item username |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=cut |
75
|
|
|
|
|
|
|
has 'username' => ( |
76
|
|
|
|
|
|
|
is => 'ro', |
77
|
|
|
|
|
|
|
isa => 'Str', |
78
|
|
|
|
|
|
|
required => 0, |
79
|
|
|
|
|
|
|
writer => '_set_username', |
80
|
|
|
|
|
|
|
); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=item timeout |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Timeout when communicating with Pingboard in seconds. Optional. Default: 10 |
85
|
|
|
|
|
|
|
Will only be in effect if you allow the useragent to be built in this module. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=cut |
88
|
|
|
|
|
|
|
has 'timeout' => ( |
89
|
|
|
|
|
|
|
is => 'ro', |
90
|
|
|
|
|
|
|
isa => 'Int', |
91
|
|
|
|
|
|
|
required => 1, |
92
|
|
|
|
|
|
|
default => 10, |
93
|
|
|
|
|
|
|
); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=item default_backoff |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Optional. Default: 10 |
98
|
|
|
|
|
|
|
Time in seconds to back off before retrying request. |
99
|
|
|
|
|
|
|
If a 429 response is given and the Retry-Time header is provided by the api this will be overridden. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=cut |
102
|
|
|
|
|
|
|
has 'default_backoff' => ( |
103
|
|
|
|
|
|
|
is => 'ro', |
104
|
|
|
|
|
|
|
isa => 'Int', |
105
|
|
|
|
|
|
|
required => 1, |
106
|
|
|
|
|
|
|
default => 10, |
107
|
|
|
|
|
|
|
); |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=item default_page_size |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Optional. Default: 100 |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=cut |
114
|
|
|
|
|
|
|
has 'default_page_size' => ( |
115
|
|
|
|
|
|
|
is => 'rw', |
116
|
|
|
|
|
|
|
isa => 'Int', |
117
|
|
|
|
|
|
|
required => 1, |
118
|
|
|
|
|
|
|
default => 100, |
119
|
|
|
|
|
|
|
); |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=item retry_on_status |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
Optional. Default: [ 429, 500, 502, 503, 504 ] |
124
|
|
|
|
|
|
|
Which http response codes should we retry on? |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=cut |
127
|
|
|
|
|
|
|
has 'retry_on_status' => ( |
128
|
|
|
|
|
|
|
is => 'ro', |
129
|
|
|
|
|
|
|
isa => 'ArrayRef', |
130
|
|
|
|
|
|
|
required => 1, |
131
|
|
|
|
|
|
|
default => sub{ [ 429, 500, 502, 503, 504 ] }, |
132
|
|
|
|
|
|
|
); |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item max_tries |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Optional. Default: undef |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
Limit maximum number of times a query should be attempted before failing. If undefined then unlimited retries |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=cut |
141
|
|
|
|
|
|
|
has 'max_tries' => ( |
142
|
|
|
|
|
|
|
is => 'ro', |
143
|
|
|
|
|
|
|
isa => 'Int', |
144
|
|
|
|
|
|
|
); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=item api_url |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Default: https://app.pingboard.com/api/v2/ |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=cut |
151
|
|
|
|
|
|
|
has 'api_url' => ( |
152
|
|
|
|
|
|
|
is => 'ro', |
153
|
|
|
|
|
|
|
isa => 'Str', |
154
|
|
|
|
|
|
|
required => 1, |
155
|
|
|
|
|
|
|
default => 'https://app.pingboard.com/api/v2/', |
156
|
|
|
|
|
|
|
); |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=item user_agent |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
Optional. A new LWP::UserAgent will be created for you if you don't already have one you'd like to reuse. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=cut |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
has 'user_agent' => ( |
165
|
|
|
|
|
|
|
is => 'ro', |
166
|
|
|
|
|
|
|
isa => 'LWP::UserAgent', |
167
|
|
|
|
|
|
|
required => 1, |
168
|
|
|
|
|
|
|
lazy => 1, |
169
|
|
|
|
|
|
|
builder => '_build_user_agent', |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
); |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=item loglevel |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Optionally override the global loglevel for this module |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=cut |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
has 'loglevel' => ( |
180
|
|
|
|
|
|
|
is => 'rw', |
181
|
|
|
|
|
|
|
isa => 'Str', |
182
|
|
|
|
|
|
|
trigger => \&_set_loglevel, |
183
|
|
|
|
|
|
|
); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
has '_access_token' => ( |
186
|
|
|
|
|
|
|
is => 'ro', |
187
|
|
|
|
|
|
|
isa => 'Str', |
188
|
|
|
|
|
|
|
required => 0, |
189
|
|
|
|
|
|
|
writer => '_set_access_token', |
190
|
|
|
|
|
|
|
); |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
has '_headers' => ( |
193
|
|
|
|
|
|
|
is => 'ro', |
194
|
|
|
|
|
|
|
isa => 'HTTP::Headers', |
195
|
|
|
|
|
|
|
writer => '_set_headers', |
196
|
|
|
|
|
|
|
); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
has '_access_token_expires' => ( |
199
|
|
|
|
|
|
|
is => 'ro', |
200
|
|
|
|
|
|
|
isa => 'Int', |
201
|
|
|
|
|
|
|
required => 0, |
202
|
|
|
|
|
|
|
writer => '_set_access_token_expires', |
203
|
|
|
|
|
|
|
); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub _set_loglevel { |
206
|
0
|
|
|
0
|
|
0
|
my( $self, $level ) = @_; |
207
|
0
|
|
|
|
|
0
|
$self->log->warn( "Setting new loglevel: $level" ); |
208
|
0
|
|
|
|
|
0
|
$self->log->level( $level ); |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
sub _build_user_agent { |
212
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
213
|
0
|
|
|
|
|
0
|
$self->log->debug( "Building useragent" ); |
214
|
0
|
|
|
|
|
0
|
my $ua = LWP::UserAgent->new( |
215
|
|
|
|
|
|
|
keep_alive => 1, |
216
|
|
|
|
|
|
|
timeout => $self->timeout, |
217
|
|
|
|
|
|
|
); |
218
|
0
|
|
|
|
|
0
|
return $ua; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=back |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=head1 METHODS |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=over 4 |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=item valid_access_token |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
Will return a valid access token. |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=cut |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub valid_access_token { |
234
|
4
|
|
|
4
|
1
|
25
|
my ( $self, %params ) = validated_hash( |
235
|
|
|
|
|
|
|
\@_, |
236
|
|
|
|
|
|
|
username => { isa => 'Str', optional => 1 }, |
237
|
|
|
|
|
|
|
password => { isa => 'Str', optional => 1 }, |
238
|
|
|
|
|
|
|
refresh_token => { isa => 'Str', optional => 1 }, |
239
|
|
|
|
|
|
|
); |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# If we still have a valid access token, use this |
242
|
|
|
|
|
|
|
#if( $self->_access_token and $self->_access_token_expires > ( time() + 5 ) ){ |
243
|
4
|
50
|
|
|
|
873
|
if( $self->access_token_is_valid ){ |
244
|
0
|
|
|
|
|
0
|
return $self->_access_token; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
4
|
|
33
|
|
|
151
|
$params{username} ||= $self->username; |
248
|
4
|
|
33
|
|
|
151
|
$params{password} ||= $self->password; |
249
|
4
|
|
33
|
|
|
163
|
$params{refresh_token} ||= $self->refresh_token; |
250
|
|
|
|
|
|
|
|
251
|
4
|
|
|
|
|
13
|
my $h = HTTP::Headers->new(); |
252
|
4
|
|
|
|
|
32
|
$h->header( 'Content-Type' => "application/json" ); |
253
|
4
|
|
|
|
|
142
|
$h->header( 'Accept' => "application/json" ); |
254
|
|
|
|
|
|
|
|
255
|
4
|
|
|
|
|
126
|
my $data; |
256
|
4
|
50
|
33
|
|
|
27
|
if( $params{username} and $params{refresh_token} ){ |
|
|
50
|
33
|
|
|
|
|
257
|
0
|
|
|
|
|
0
|
$self->log->debug( "Requesting fresh access_token with refresh_token: $params{refresh_token}" ); |
258
|
|
|
|
|
|
|
$data = $self->_request_from_api( |
259
|
|
|
|
|
|
|
method => 'POST', |
260
|
|
|
|
|
|
|
headers => $h, |
261
|
0
|
|
|
|
|
0
|
uri => sprintf( "https://app.pingboard.com/oauth/token?username=%s&refresh_token=%s&grant_type=refresh_token", $params{username}, $params{refresh_token} ), |
262
|
|
|
|
|
|
|
); |
263
|
|
|
|
|
|
|
}elsif( $params{username} and $params{password} ){ |
264
|
0
|
|
|
|
|
0
|
$self->log->debug( "Requesting fresh access_token with username and password for: $params{username}" ); |
265
|
|
|
|
|
|
|
$data = $self->_request_from_api( |
266
|
|
|
|
|
|
|
method => 'POST', |
267
|
|
|
|
|
|
|
headers => $h, |
268
|
0
|
|
|
|
|
0
|
uri => sprintf( "https://app.pingboard.com/oauth/token?username=%s&password=%s&grant_type=password", $params{username}, uri_encode( $params{password} ) ), |
269
|
|
|
|
|
|
|
); |
270
|
|
|
|
|
|
|
}else{ |
271
|
4
|
|
|
|
|
66
|
die( "Cannot create valid access_token without a refresh_token or username and password" ); |
272
|
|
|
|
|
|
|
} |
273
|
0
|
|
|
|
|
0
|
$self->log->debug( "Response from getting access_token:\n" . Dump( $data ) ); |
274
|
0
|
|
|
|
|
0
|
my $expire_time = time() + $data->{expires_in}; |
275
|
0
|
|
|
|
|
0
|
$self->log->debug( "Got new access_token: $data->{access_token} which expires at " . localtime( $expire_time ) ); |
276
|
0
|
0
|
|
|
|
0
|
if( $data->{refresh_token} ){ |
277
|
0
|
|
|
|
|
0
|
$self->log->debug( "Got new refresh_token: $data->{refresh_token}" ); |
278
|
0
|
|
|
|
|
0
|
$self->_set_refresh_token( $data->{refresh_token} ); |
279
|
|
|
|
|
|
|
} |
280
|
0
|
|
|
|
|
0
|
$self->_set_access_token( $data->{access_token} ); |
281
|
0
|
|
|
|
|
0
|
$self->_set_access_token_expires( $expire_time ); |
282
|
0
|
|
|
|
|
0
|
return $data->{access_token}; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=item access_token_is_valid |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
Returns true if a valid access token exists (with at least 5 seconds validity remaining). |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
=cut |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub access_token_is_valid { |
292
|
8
|
|
|
8
|
1
|
12
|
my $self = shift; |
293
|
8
|
50
|
33
|
|
|
297
|
return 1 if( $self->_access_token and $self->_access_token_expires > ( time() + 5 ) ); |
294
|
8
|
|
|
|
|
27
|
return 0; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
=item headers |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
Returns a HTTP::Headers object with the Authorization header set with a valid access token |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=cut |
302
|
|
|
|
|
|
|
sub headers { |
303
|
4
|
|
|
4
|
1
|
6
|
my $self = shift; |
304
|
4
|
50
|
33
|
|
|
9
|
if( not $self->access_token_is_valid or not $self->_headers ){ |
305
|
4
|
|
|
|
|
24
|
my $h = HTTP::Headers->new(); |
306
|
4
|
|
|
|
|
35
|
$h->header( 'Content-Type' => "application/json" ); |
307
|
4
|
|
|
|
|
225
|
$h->header( 'Accept' => "application/json" ); |
308
|
4
|
|
|
|
|
139
|
$h->header( 'Authorization' => "Bearer " . $self->valid_access_token ); |
309
|
0
|
|
|
|
|
0
|
$self->_set_headers( $h ); |
310
|
|
|
|
|
|
|
} |
311
|
0
|
|
|
|
|
0
|
return $self->_headers; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=item get_users |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=over 4 |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=item id |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
Optional. The user id to get |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=item limit |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
Optional. Maximum number of entries to fetch. |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=item page_size |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
Optional. Page size to use when fetching. |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=back |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=cut |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub get_users { |
335
|
1
|
|
|
1
|
1
|
3170
|
my ( $self, %params ) = validated_hash( |
336
|
|
|
|
|
|
|
\@_, |
337
|
|
|
|
|
|
|
id => { isa => 'Int', optional => 1 }, |
338
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
339
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
340
|
|
|
|
|
|
|
); |
341
|
1
|
|
|
|
|
906
|
$params{field} = 'users'; |
342
|
1
|
50
|
|
|
|
5
|
$params{path} = 'users' . ( $params{id} ? '/' . $params{id} : '' ); |
343
|
1
|
|
|
|
|
2
|
delete( $params{id} ); |
344
|
1
|
|
|
|
|
6
|
return $self->_paged_request_from_api( %params ); |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=item get_groups |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=over 4 |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=item id (optional) |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
The group id to get |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=item limit |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Optional. Maximum number of entries to fetch. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=item page_size |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Optional. Page size to use when fetching. |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=back |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
=cut |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
sub get_groups { |
368
|
1
|
|
|
1
|
1
|
816
|
my ( $self, %params ) = validated_hash( |
369
|
|
|
|
|
|
|
\@_, |
370
|
|
|
|
|
|
|
id => { isa => 'Int', optional => 1 }, |
371
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
372
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
373
|
|
|
|
|
|
|
); |
374
|
1
|
|
|
|
|
792
|
$params{field} = 'groups'; |
375
|
1
|
50
|
|
|
|
6
|
$params{path} = 'groups' . ( $params{id} ? '/' . $params{id} : '' ); |
376
|
1
|
|
|
|
|
2
|
delete( $params{id} ); |
377
|
1
|
|
|
|
|
9
|
return $self->_paged_request_from_api( %params ); |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=item get_custom_fields |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=over 4 |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=item id (optional) |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
The resource id to get |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=item limit |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Optional. Maximum number of entries to fetch. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=item page_size |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
Optional. Page size to use when fetching. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=back |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=cut |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
sub get_custom_fields { |
401
|
0
|
|
|
0
|
1
|
0
|
my ( $self, %params ) = validated_hash( |
402
|
|
|
|
|
|
|
\@_, |
403
|
|
|
|
|
|
|
id => { isa => 'Int', optional => 1 }, |
404
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
405
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
406
|
|
|
|
|
|
|
); |
407
|
0
|
|
|
|
|
0
|
$params{field} = 'custom_fields'; |
408
|
0
|
0
|
|
|
|
0
|
$params{path} = 'custom_fields' . ( $params{id} ? '/' . $params{id} : '' ); |
409
|
0
|
|
|
|
|
0
|
delete( $params{id} ); |
410
|
0
|
|
|
|
|
0
|
return $self->_paged_request_from_api( %params ); |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
=item get_linked_accounts |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=over 4 |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=item id |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
The resource id to get |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=back |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=cut |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub get_linked_accounts { |
426
|
0
|
|
|
0
|
1
|
0
|
my ( $self, %params ) = validated_hash( |
427
|
|
|
|
|
|
|
\@_, |
428
|
|
|
|
|
|
|
id => { isa => 'Int'}, |
429
|
|
|
|
|
|
|
); |
430
|
0
|
|
|
|
|
0
|
$params{field} = 'linked_accounts'; |
431
|
0
|
|
|
|
|
0
|
$params{path} = 'linked_accounts/' . $params{id}; |
432
|
0
|
|
|
|
|
0
|
delete( $params{id} ); |
433
|
0
|
|
|
|
|
0
|
return $self->_paged_request_from_api( %params ); |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=item get_linked_account_providers |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=over 4 |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=item id (optional) |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
The resource id to get |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=item limit |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
Optional. Maximum number of entries to fetch. |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=item page_size |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
Optional. Page size to use when fetching. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=back |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=cut |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
sub get_linked_account_providers { |
457
|
1
|
|
|
1
|
1
|
772
|
my ( $self, %params ) = validated_hash( |
458
|
|
|
|
|
|
|
\@_, |
459
|
|
|
|
|
|
|
id => { isa => 'Int', optional => 1 }, |
460
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
461
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
462
|
|
|
|
|
|
|
); |
463
|
1
|
|
|
|
|
769
|
$params{field} = 'linked_account_providers'; |
464
|
1
|
50
|
|
|
|
4
|
$params{path} = 'linked_account_providers' . ( $params{id} ? '/' . $params{id} : '' ); |
465
|
1
|
|
|
|
|
3
|
delete( $params{id} ); |
466
|
1
|
|
|
|
|
4
|
return $self->_paged_request_from_api( %params ); |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=item get_statuses |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
=over 4 |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=item id (optional) |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
The resource id to get |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=item limit |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
Optional. Maximum number of entries to fetch. |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=item page_size |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
Optional. Page size to use when fetching. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=back |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=cut |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
sub get_statuses { |
490
|
1
|
|
|
1
|
1
|
593
|
my ( $self, %params ) = validated_hash( |
491
|
|
|
|
|
|
|
\@_, |
492
|
|
|
|
|
|
|
id => { isa => 'Int', optional => 1 }, |
493
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
494
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
495
|
|
|
|
|
|
|
); |
496
|
1
|
|
|
|
|
804
|
$params{field} = 'statuses'; |
497
|
1
|
50
|
|
|
|
5
|
$params{path} = 'statuses' . ( $params{id} ? '/' . $params{id} : '' ); |
498
|
1
|
|
|
|
|
3
|
delete( $params{id} ); |
499
|
1
|
|
|
|
|
5
|
return $self->_paged_request_from_api( %params ); |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=item clear_cache_object_id |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
Clears an object from the cache. |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=over 4 |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=item object_id |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
Required. Object id to clear from the cache. |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=back |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
Returns whether cache_del was successful or not |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=cut |
518
|
|
|
|
|
|
|
sub clear_cache_object_id { |
519
|
0
|
|
|
0
|
1
|
0
|
my ( $self, %params ) = validated_hash( |
520
|
|
|
|
|
|
|
\@_, |
521
|
|
|
|
|
|
|
object_id => { isa => 'Str' } |
522
|
|
|
|
|
|
|
); |
523
|
|
|
|
|
|
|
|
524
|
0
|
|
|
|
|
0
|
$self->log->debug( "Clearing cache id: $params{object_id}" ); |
525
|
0
|
|
|
|
|
0
|
my $foo = $self->cache_del( $params{object_id} ); |
526
|
|
|
|
|
|
|
|
527
|
0
|
|
|
|
|
0
|
return $foo; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
sub _paged_request_from_api { |
531
|
4
|
|
|
4
|
|
36
|
my ( $self, %params ) = validated_hash( |
532
|
|
|
|
|
|
|
\@_, |
533
|
|
|
|
|
|
|
method => { isa => 'Str', optional => 1, default => 'GET' }, |
534
|
|
|
|
|
|
|
path => { isa => 'Str' }, |
535
|
|
|
|
|
|
|
field => { isa => 'Str' }, |
536
|
|
|
|
|
|
|
limit => { isa => 'Int', optional => 1 }, |
537
|
|
|
|
|
|
|
page_size => { isa => 'Int', optional => 1 }, |
538
|
|
|
|
|
|
|
body => { isa => 'Str', optional => 1 }, |
539
|
|
|
|
|
|
|
); |
540
|
4
|
|
|
|
|
2585
|
my @results; |
541
|
4
|
|
|
|
|
6
|
my $page = 1; |
542
|
|
|
|
|
|
|
|
543
|
4
|
|
33
|
|
|
167
|
$params{page_size} ||= $self->default_page_size; |
544
|
4
|
50
|
33
|
|
|
26
|
if( $params{limit} and $params{limit} < $params{page_size} ){ |
545
|
4
|
|
|
|
|
9
|
$params{page_size} = $params{limit}; |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
|
548
|
4
|
|
|
|
|
5
|
my $response = undef; |
549
|
|
|
|
|
|
|
do{ |
550
|
|
|
|
|
|
|
$response = $self->_request_from_api( |
551
|
|
|
|
|
|
|
method => $params{method}, |
552
|
|
|
|
|
|
|
path => $params{path} . ( $params{path} =~ m/\?/ ? '&' : '?' ) . 'page=' . $page . '&page_size=' . $params{page_size}, |
553
|
4
|
50
|
|
|
|
28
|
); |
554
|
0
|
|
|
|
|
0
|
push( @results, @{ $response->{$params{field} } } ); |
|
0
|
|
|
|
|
0
|
|
555
|
0
|
|
|
|
|
0
|
$page++; |
556
|
4
|
|
0
|
|
|
8
|
}while( $response->{meta}{$params{field}}{page} < $response->{meta}{$params{field}}{page_count} and ( not $params{limit} or scalar( @results ) < $params{limit} ) ); |
|
|
|
0
|
|
|
|
|
557
|
0
|
|
|
|
|
0
|
return @results; |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
sub _request_from_api { |
562
|
4
|
|
|
4
|
|
33
|
my ( $self, %params ) = validated_hash( |
563
|
|
|
|
|
|
|
\@_, |
564
|
|
|
|
|
|
|
method => { isa => 'Str' }, |
565
|
|
|
|
|
|
|
path => { isa => 'Str', optional => 1 }, |
566
|
|
|
|
|
|
|
uri => { isa => 'Str', optional => 1 }, |
567
|
|
|
|
|
|
|
body => { isa => 'Str', optional => 1 }, |
568
|
|
|
|
|
|
|
headers => { isa => 'HTTP::Headers', optional => 1 }, |
569
|
|
|
|
|
|
|
fields => { isa => 'HashRef', optional => 1 }, |
570
|
|
|
|
|
|
|
); |
571
|
4
|
|
|
|
|
2264
|
my $url; |
572
|
4
|
50
|
|
|
|
14
|
if( $params{uri} ){ |
|
|
50
|
|
|
|
|
|
573
|
0
|
|
|
|
|
0
|
$url = $params{uri}; |
574
|
|
|
|
|
|
|
}elsif( $params{path} ){ |
575
|
4
|
|
|
|
|
149
|
$url = $self->api_url . $params{path}; |
576
|
|
|
|
|
|
|
}else{ |
577
|
0
|
|
|
|
|
0
|
$self->log->logdie( "Cannot request without either a path or uri" ); |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
my $request = HTTP::Request->new( |
581
|
|
|
|
|
|
|
$params{method}, |
582
|
|
|
|
|
|
|
$url, |
583
|
4
|
|
33
|
|
|
18
|
$params{headers} || $self->headers, |
584
|
|
|
|
|
|
|
); |
585
|
0
|
0
|
|
|
|
|
$request->content( $params{body} ) if( $params{body} ); |
586
|
|
|
|
|
|
|
|
587
|
0
|
|
|
|
|
|
$self->log->debug( "Requesting: " . $request->uri ); |
588
|
0
|
0
|
|
|
|
|
$self->log->trace( "Request:\n" . Dump( $request ) ) if $self->log->is_trace; |
589
|
|
|
|
|
|
|
|
590
|
0
|
|
|
|
|
|
my $response; |
591
|
0
|
|
|
|
|
|
my $retry = 1; |
592
|
0
|
|
|
|
|
|
my $try_count = 0; |
593
|
0
|
|
|
|
|
|
do{ |
594
|
0
|
|
|
|
|
|
my $retry_delay = $self->default_backoff; |
595
|
0
|
|
|
|
|
|
$try_count++; |
596
|
|
|
|
|
|
|
# Fields are a special use-case for GET requests: |
597
|
|
|
|
|
|
|
# https://metacpan.org/pod/LWP::UserAgent#ua-get-url-field_name-value |
598
|
0
|
0
|
|
|
|
|
if( $params{fields} ){ |
599
|
0
|
0
|
|
|
|
|
if( $request->method ne 'GET' ){ |
600
|
0
|
|
|
|
|
|
$self->log->logdie( 'Cannot use fields unless the request method is GET' ); |
601
|
|
|
|
|
|
|
} |
602
|
0
|
|
|
|
|
|
my %fields = %{ $params{fields} }; |
|
0
|
|
|
|
|
|
|
603
|
0
|
|
|
|
|
|
my $headers = $request->headers(); |
604
|
0
|
|
|
|
|
|
foreach( keys( %{ $headers } ) ){ |
|
0
|
|
|
|
|
|
|
605
|
0
|
|
|
|
|
|
$fields{$_} = $headers->{$_}; |
606
|
|
|
|
|
|
|
} |
607
|
0
|
|
|
|
|
|
$self->log->trace( "Fields:\n" . Dump( \%fields ) ); |
608
|
0
|
|
|
|
|
|
$response = $self->user_agent->get( |
609
|
|
|
|
|
|
|
$request->uri(), |
610
|
|
|
|
|
|
|
%fields, |
611
|
|
|
|
|
|
|
); |
612
|
|
|
|
|
|
|
}else{ |
613
|
0
|
|
|
|
|
|
$response = $self->user_agent->request( $request ); |
614
|
|
|
|
|
|
|
} |
615
|
0
|
0
|
|
|
|
|
if( $response->is_success ){ |
616
|
0
|
|
|
|
|
|
$retry = 0; |
617
|
|
|
|
|
|
|
}else{ |
618
|
0
|
0
|
|
|
|
|
if( grep{ $_ == $response->code } @{ $self->retry_on_status } ){ |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
619
|
0
|
0
|
|
|
|
|
if( $response->code == 429 ){ |
620
|
|
|
|
|
|
|
# if retry-after header exists and has valid data use this for backoff time |
621
|
0
|
0
|
0
|
|
|
|
if( $response->header( 'Retry-After' ) and $response->header('Retry-After') =~ /^\d+$/ ) { |
622
|
0
|
|
|
|
|
|
$retry_delay = $response->header('Retry-After'); |
623
|
|
|
|
|
|
|
} |
624
|
0
|
|
|
|
|
|
$self->log->warn( sprintf( "Received a %u (Too Many Requests) response with 'Retry-After' header... going to backoff and retry in %u seconds!", |
625
|
|
|
|
|
|
|
$response->code, |
626
|
|
|
|
|
|
|
$retry_delay, |
627
|
|
|
|
|
|
|
) ); |
628
|
|
|
|
|
|
|
}else{ |
629
|
0
|
|
|
|
|
|
$self->log->warn( sprintf( "Received a %u: %s ... going to backoff and retry in %u seconds!", |
630
|
|
|
|
|
|
|
$response->code, |
631
|
|
|
|
|
|
|
$response->decoded_content, |
632
|
|
|
|
|
|
|
$retry_delay |
633
|
|
|
|
|
|
|
) ); |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
}else{ |
636
|
0
|
|
|
|
|
|
$retry = 0; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
0
|
0
|
|
|
|
|
if( $retry == 1 ){ |
640
|
0
|
0
|
0
|
|
|
|
if( not $self->max_tries or $self->max_tries > $try_count ){ |
641
|
0
|
|
|
|
|
|
$self->log->debug( sprintf( "Try %u failed... sleeping %u before next attempt", $try_count, $retry_delay ) ); |
642
|
0
|
|
|
|
|
|
sleep( $retry_delay ); |
643
|
|
|
|
|
|
|
}else{ |
644
|
0
|
|
|
|
|
|
$self->log->debug( sprintf( "Try %u failed... exceeded max_tries (%u) so not going to retry", $try_count, $self->max_tries ) ); |
645
|
0
|
|
|
|
|
|
$retry = 0; |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
}while( $retry ); |
650
|
|
|
|
|
|
|
|
651
|
0
|
0
|
|
|
|
|
$self->log->trace( "Last response:\n", Dump( $response ) ) if $self->log->is_trace; |
652
|
0
|
0
|
|
|
|
|
if( not $response->is_success ){ |
653
|
0
|
|
|
|
|
|
$self->log->logdie( "API Error: http status:". $response->code .' '. $response->message . ' Content: ' . $response->content); |
654
|
|
|
|
|
|
|
} |
655
|
0
|
0
|
|
|
|
|
if( $response->decoded_content ){ |
656
|
0
|
|
|
|
|
|
return decode_json( encode( 'utf8', $response->decoded_content ) ); |
657
|
|
|
|
|
|
|
} |
658
|
0
|
|
|
|
|
|
return; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
1; |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
=back |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=head1 COPYRIGHT |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
Copyright 2015, Robin Clarke |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=head1 AUTHOR |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
Robin Clarke <robin@robinclarke.net> |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
Jeremy Falling <projects@falling.se> |
675
|
|
|
|
|
|
|
|