line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Bintray::API::Session; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
####################### |
4
|
|
|
|
|
|
|
# LOAD CORE MODULES |
5
|
|
|
|
|
|
|
####################### |
6
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
603
|
|
7
|
1
|
|
|
1
|
|
7
|
use warnings FATAL => 'all'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
45
|
|
8
|
1
|
|
|
1
|
|
4
|
use Carp qw(croak carp); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
109
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
####################### |
11
|
|
|
|
|
|
|
# VERSION |
12
|
|
|
|
|
|
|
####################### |
13
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
####################### |
16
|
|
|
|
|
|
|
# LOAD CPAN MODULES |
17
|
|
|
|
|
|
|
####################### |
18
|
1
|
|
|
1
|
|
1016
|
use JSON::Any; |
|
1
|
|
|
|
|
18378
|
|
|
1
|
|
|
|
|
8
|
|
19
|
1
|
|
|
1
|
|
7171
|
use Encode qw(); |
|
1
|
|
|
|
|
105975
|
|
|
1
|
|
|
|
|
29
|
|
20
|
1
|
|
|
1
|
|
1313
|
use HTTP::Tiny qw(); |
|
1
|
|
|
|
|
272028
|
|
|
1
|
|
|
|
|
33
|
|
21
|
1
|
|
|
1
|
|
827
|
use URI::Encode qw(); |
|
1
|
|
|
|
|
1278
|
|
|
1
|
|
|
|
|
20
|
|
22
|
1
|
|
|
1
|
|
698
|
use MIME::Base64 qw(encode_base64); |
|
1
|
|
|
|
|
722
|
|
|
1
|
|
|
|
|
67
|
|
23
|
1
|
|
|
1
|
|
8
|
use Params::Validate qw(validate_with :types); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
217
|
|
24
|
|
|
|
|
|
|
|
25
|
1
|
|
|
|
|
8
|
use Object::Tiny qw( |
26
|
|
|
|
|
|
|
json |
27
|
|
|
|
|
|
|
debug |
28
|
|
|
|
|
|
|
apikey |
29
|
|
|
|
|
|
|
apiurl |
30
|
|
|
|
|
|
|
error |
31
|
|
|
|
|
|
|
client |
32
|
|
|
|
|
|
|
limits |
33
|
|
|
|
|
|
|
hascreds |
34
|
|
|
|
|
|
|
username |
35
|
|
|
|
|
|
|
urlencoder |
36
|
1
|
|
|
1
|
|
6
|
); |
|
1
|
|
|
|
|
2
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
####################### |
39
|
|
|
|
|
|
|
# PUBLIC METHODS |
40
|
|
|
|
|
|
|
####################### |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
## Constructor |
43
|
|
|
|
|
|
|
sub new { |
44
|
0
|
|
|
0
|
0
|
|
my ( $class, @args ) = @_; |
45
|
0
|
|
|
|
|
|
my %opts = validate_with( |
46
|
|
|
|
|
|
|
params => [@args], |
47
|
|
|
|
|
|
|
spec => { |
48
|
|
|
|
|
|
|
username => { |
49
|
|
|
|
|
|
|
type => SCALAR, |
50
|
|
|
|
|
|
|
default => '', |
51
|
|
|
|
|
|
|
}, |
52
|
|
|
|
|
|
|
apikey => { |
53
|
|
|
|
|
|
|
type => SCALAR, |
54
|
|
|
|
|
|
|
default => '', |
55
|
|
|
|
|
|
|
}, |
56
|
|
|
|
|
|
|
debug => { |
57
|
|
|
|
|
|
|
type => BOOLEAN, |
58
|
|
|
|
|
|
|
default => 0, |
59
|
|
|
|
|
|
|
}, |
60
|
|
|
|
|
|
|
}, |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# Set API URL |
64
|
0
|
|
|
|
|
|
$opts{apiurl} = 'https://bintray.com/api/v1'; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# Check for credentials |
67
|
0
|
0
|
0
|
|
|
|
if ( $opts{username} and $opts{apikey} ) { |
68
|
0
|
|
|
|
|
|
$opts{hascreds} = 1; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# Init HTTP Client |
72
|
0
|
0
|
|
|
|
|
$opts{client} = HTTP::Tiny->new( |
73
|
|
|
|
|
|
|
agent => 'perl-bintray-api-client', |
74
|
|
|
|
|
|
|
default_headers => { |
75
|
|
|
|
|
|
|
'Accept' => 'application/json', |
76
|
|
|
|
|
|
|
'Content-Type' => 'application/json', |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# Save Credentials for Basic Auth |
79
|
|
|
|
|
|
|
( |
80
|
|
|
|
|
|
|
$opts{hascreds} |
81
|
|
|
|
|
|
|
? ( |
82
|
|
|
|
|
|
|
'Authorization' => sprintf( '%s %s', |
83
|
|
|
|
|
|
|
'Basic', encode_base64( join( ':', $opts{username}, $opts{apikey} ), '' ), |
84
|
|
|
|
|
|
|
), |
85
|
|
|
|
|
|
|
) |
86
|
|
|
|
|
|
|
: () |
87
|
|
|
|
|
|
|
), |
88
|
|
|
|
|
|
|
}, |
89
|
|
|
|
|
|
|
); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# Init Encoder |
92
|
0
|
|
|
|
|
|
$opts{urlencoder} = URI::Encode->new(); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# Init JSON |
95
|
0
|
|
|
|
|
|
$opts{json} = JSON::Any->new( |
96
|
|
|
|
|
|
|
utf8 => 1, |
97
|
|
|
|
|
|
|
); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# Init Empty error |
100
|
0
|
|
|
|
|
|
$opts{error} = ''; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# Return Object (tiny) |
103
|
0
|
|
|
|
|
|
return $class->SUPER::new(%opts); |
104
|
|
|
|
|
|
|
} ## end sub new |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
## Talk |
107
|
|
|
|
|
|
|
sub talk { |
108
|
0
|
|
|
0
|
0
|
|
my ( $self, @args ) = @_; |
109
|
0
|
|
|
|
|
|
my %opts = validate_with( |
110
|
|
|
|
|
|
|
params => [@args], |
111
|
|
|
|
|
|
|
spec => { |
112
|
|
|
|
|
|
|
method => { |
113
|
|
|
|
|
|
|
type => SCALAR, |
114
|
|
|
|
|
|
|
default => 'GET', |
115
|
|
|
|
|
|
|
}, |
116
|
|
|
|
|
|
|
path => { |
117
|
|
|
|
|
|
|
type => SCALAR, |
118
|
|
|
|
|
|
|
}, |
119
|
|
|
|
|
|
|
query => { |
120
|
|
|
|
|
|
|
type => ARRAYREF, |
121
|
|
|
|
|
|
|
default => [], |
122
|
|
|
|
|
|
|
}, |
123
|
|
|
|
|
|
|
params => { |
124
|
|
|
|
|
|
|
type => ARRAYREF, |
125
|
|
|
|
|
|
|
default => [], |
126
|
|
|
|
|
|
|
}, |
127
|
|
|
|
|
|
|
content => { |
128
|
|
|
|
|
|
|
type => SCALAR, |
129
|
|
|
|
|
|
|
default => '', |
130
|
|
|
|
|
|
|
}, |
131
|
|
|
|
|
|
|
wantheaders => { |
132
|
|
|
|
|
|
|
type => BOOLEAN, |
133
|
|
|
|
|
|
|
default => 0, |
134
|
|
|
|
|
|
|
}, |
135
|
|
|
|
|
|
|
anon => { |
136
|
|
|
|
|
|
|
type => BOOLEAN, |
137
|
|
|
|
|
|
|
default => 0, |
138
|
|
|
|
|
|
|
}, |
139
|
|
|
|
|
|
|
}, |
140
|
|
|
|
|
|
|
); |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# Check for Credentials |
143
|
0
|
0
|
|
|
|
|
if ( not $opts{anon} ) { |
144
|
0
|
0
|
|
|
|
|
croak "ERROR: API Method $opts{path} requires authentication." |
145
|
|
|
|
|
|
|
. " Please set a username and apikey to use this." |
146
|
|
|
|
|
|
|
unless $self->hascreds(); |
147
|
|
|
|
|
|
|
} ## end if ( not $opts{anon} ) |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# Build Path |
150
|
0
|
|
|
|
|
|
$opts{path} =~ s{^\/}{}x; |
151
|
0
|
|
|
|
|
|
my $url = join( '/', $self->apiurl(), $opts{path} ); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# Build Query |
154
|
0
|
|
|
|
|
|
my @query_parts; |
155
|
0
|
|
|
|
|
|
foreach my $_q ( @{ $opts{query} } ) { |
|
0
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
|
foreach my $_k ( keys %{$_q} ) { |
|
0
|
|
|
|
|
|
|
157
|
0
|
|
|
|
|
|
push @query_parts, sprintf( '%s=%s', $_k, $_q->{$_k} ); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} ## end foreach my $_q ( @{ $opts{query...}}) |
160
|
0
|
0
|
|
|
|
|
if (@query_parts) { |
161
|
0
|
|
|
|
|
|
$url .= '?' . join( '&', @query_parts ); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# Build Params |
165
|
0
|
|
|
|
|
|
my @param_parts; |
166
|
0
|
|
|
|
|
|
foreach my $_p ( @{ $opts{params} } ) { |
|
0
|
|
|
|
|
|
|
167
|
0
|
|
|
|
|
|
push @param_parts, sprintf( '%s=%s', each %{$_p} ); |
|
0
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
} |
169
|
0
|
0
|
|
|
|
|
if (@param_parts) { |
170
|
0
|
|
|
|
|
|
$url .= ';' . join( ';', @param_parts ); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# Encode |
174
|
0
|
|
|
|
|
|
$url = $self->urlencoder->encode($url); |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# Talk |
177
|
0
|
0
|
|
|
|
|
my $response = $self->client()->request( |
178
|
|
|
|
|
|
|
uc( $opts{method} ), $url, # URL |
179
|
|
|
|
|
|
|
{ |
180
|
|
|
|
|
|
|
# Check for content |
181
|
|
|
|
|
|
|
$opts{content} ? ( content => $opts{content} ) : (), |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# Check Response |
186
|
0
|
0
|
|
|
|
|
if ( not $response->{success} ) { |
187
|
0
|
0
|
|
|
|
|
$self->{error} |
188
|
|
|
|
|
|
|
= "API Call to $opts{path} failed : " |
189
|
|
|
|
|
|
|
. " URL: $response->{url}." |
190
|
|
|
|
|
|
|
. " STATUS: $response->{status}." |
191
|
|
|
|
|
|
|
. " REASON: $response->{reason}." |
192
|
|
|
|
|
|
|
. ( |
193
|
|
|
|
|
|
|
( $response->{status} ne '404' ) ? " CONTENT: $response->{content}." : '' ); |
194
|
0
|
0
|
|
|
|
|
carp $self->{error} if $self->debug; |
195
|
0
|
|
|
|
|
|
return; |
196
|
|
|
|
|
|
|
} ## end if ( not $response->{success...}) |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# Collect Response |
199
|
0
|
|
|
|
|
|
my $api_response_data; |
200
|
0
|
0
|
|
|
|
|
if ( $response->{content} ) { |
201
|
0
|
|
|
|
|
|
$api_response_data = $self->json->decode( |
202
|
|
|
|
|
|
|
Encode::decode( 'utf-8-strict', $response->{content} ) ); |
203
|
|
|
|
|
|
|
} ## end if ( $response->{content...}) |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# Collect Headers |
206
|
0
|
|
|
|
|
|
my $api_headers = {}; |
207
|
0
|
|
|
|
|
|
foreach my $_h ( grep { /^x\-/xi } keys %{ $response->{headers} } ) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
208
|
0
|
|
|
|
|
|
$api_headers->{$_h} = $response->{headers}->{$_h}; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# Save Limits |
212
|
0
|
0
|
0
|
|
|
|
if ( exists $api_headers->{'x-ratelimit-limit'} |
213
|
|
|
|
|
|
|
and exists $api_headers->{'x-ratelimit-remaining'} ) |
214
|
|
|
|
|
|
|
{ |
215
|
0
|
|
|
|
|
|
$self->{limits} = { |
216
|
|
|
|
|
|
|
limit => $api_headers->{'x-ratelimit-limit'}, |
217
|
|
|
|
|
|
|
remaining => $api_headers->{'x-ratelimit-remaining'}, |
218
|
|
|
|
|
|
|
}; |
219
|
|
|
|
|
|
|
} ## end if ( exists $api_headers...) |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# Return |
222
|
0
|
0
|
|
|
|
|
if ( $opts{wantheaders} ) { |
223
|
|
|
|
|
|
|
return { |
224
|
0
|
|
|
|
|
|
headers => $api_headers, |
225
|
|
|
|
|
|
|
data => $api_response_data, |
226
|
|
|
|
|
|
|
}; |
227
|
|
|
|
|
|
|
} ## end if ( $opts{wantheaders...}) |
228
|
0
|
|
|
|
|
|
return $api_response_data; |
229
|
|
|
|
|
|
|
} ## end sub talk |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
## Paginate |
232
|
|
|
|
|
|
|
sub paginate { |
233
|
0
|
|
|
0
|
0
|
|
my ( $self, @args ) = @_; |
234
|
0
|
|
|
|
|
|
my %opts = validate_with( |
235
|
|
|
|
|
|
|
params => [@args], |
236
|
|
|
|
|
|
|
spec => { |
237
|
|
|
|
|
|
|
query => { |
238
|
|
|
|
|
|
|
type => ARRAYREF, |
239
|
|
|
|
|
|
|
default => [], |
240
|
|
|
|
|
|
|
}, |
241
|
|
|
|
|
|
|
max => { |
242
|
|
|
|
|
|
|
type => SCALAR, |
243
|
|
|
|
|
|
|
default => 200, |
244
|
|
|
|
|
|
|
regex => qr/^\d+$/x, |
245
|
|
|
|
|
|
|
}, |
246
|
|
|
|
|
|
|
}, |
247
|
|
|
|
|
|
|
allow_extra => 1, |
248
|
|
|
|
|
|
|
); |
249
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
my $max_results = delete $opts{max}; |
251
|
0
|
|
|
|
|
|
my $num_of_results = 0; |
252
|
0
|
|
|
|
|
|
my $start_pos = 0; |
253
|
0
|
|
|
|
|
|
my $data = []; |
254
|
0
|
|
|
|
|
|
while (1) { |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# Talk |
257
|
0
|
|
|
|
|
|
my $response = $self->talk( |
258
|
|
|
|
|
|
|
%opts, |
259
|
|
|
|
|
|
|
wantheaders => 1, |
260
|
0
|
|
|
|
|
|
query => [ { start_pos => $start_pos }, @{ $opts{query} }, ], |
261
|
|
|
|
|
|
|
); |
262
|
0
|
0
|
|
|
|
|
last if not defined $response; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# Check data |
265
|
0
|
0
|
|
|
|
|
if ( ref( $response->{data} ) eq 'ARRAY' ) { |
266
|
0
|
|
|
|
|
|
push @$data, @{ $response->{data} }; |
|
0
|
|
|
|
|
|
|
267
|
0
|
|
|
|
|
|
$num_of_results += scalar( @{ $response->{data} } ); |
|
0
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
} ## end if ( ref( $response->{...})) |
269
|
|
|
|
|
|
|
else { |
270
|
0
|
|
|
|
|
|
$data = $response->{data}; |
271
|
0
|
|
|
|
|
|
last; |
272
|
|
|
|
|
|
|
} ## end else [ if ( ref( $response->{...}))] |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# Get position |
275
|
0
|
|
0
|
|
|
|
my $_total = $response->{headers}->{'x-rangelimit-total'} || 0; |
276
|
0
|
|
0
|
|
|
|
my $_start = $response->{headers}->{'x-rangelimit-startpos'} || 0; |
277
|
0
|
|
0
|
|
|
|
my $_end = $response->{headers}->{'x-rangelimit-endpos'} || 0; |
278
|
0
|
|
|
|
|
|
my $_per_page = $_end - $_start; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# Update Current |
281
|
0
|
|
|
|
|
|
$start_pos = $_end + 1; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# Continue paging? |
284
|
0
|
0
|
|
|
|
|
last if ( $num_of_results >= $max_results ); |
285
|
0
|
0
|
|
|
|
|
last if ( $num_of_results >= $_total ); |
286
|
|
|
|
|
|
|
} ## end while (1) |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# Return |
289
|
0
|
0
|
|
|
|
|
if ( $opts{wantheaders} ) { |
290
|
0
|
|
|
|
|
|
return { data => $data }; |
291
|
|
|
|
|
|
|
} |
292
|
0
|
|
|
|
|
|
return $data; |
293
|
|
|
|
|
|
|
} ## end sub paginate |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
####################### |
296
|
|
|
|
|
|
|
1; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
__END__ |