line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Rest::Generic; |
2
|
|
|
|
|
|
|
|
3
|
7
|
|
|
7
|
|
31166
|
use 5.006; |
|
7
|
|
|
|
|
23
|
|
|
7
|
|
|
|
|
294
|
|
4
|
7
|
|
|
7
|
|
42
|
use strict; |
|
7
|
|
|
|
|
19
|
|
|
7
|
|
|
|
|
249
|
|
5
|
7
|
|
|
7
|
|
35
|
use warnings FATAL => 'all'; |
|
7
|
|
|
|
|
18
|
|
|
7
|
|
|
|
|
324
|
|
6
|
|
|
|
|
|
|
|
7
|
7
|
|
|
7
|
|
10226
|
use Want; |
|
7
|
|
|
|
|
32439
|
|
|
7
|
|
|
|
|
787
|
|
8
|
7
|
|
|
7
|
|
10022
|
use URI; |
|
7
|
|
|
|
|
40875
|
|
|
7
|
|
|
|
|
240
|
|
9
|
7
|
|
|
7
|
|
8905
|
use Storable qw(dclone); |
|
7
|
|
|
|
|
26104
|
|
|
7
|
|
|
|
|
557
|
|
10
|
7
|
|
|
7
|
|
10483
|
use Net::Rest::Generic::Error; |
|
7
|
|
|
|
|
34
|
|
|
7
|
|
|
|
|
198
|
|
11
|
7
|
|
|
7
|
|
4035
|
use Net::Rest::Generic::Utility; |
|
7
|
|
|
|
|
27
|
|
|
7
|
|
|
|
|
6556
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 NAME |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Net::Rest::Generic - A tool for generically interacting with restfull (or restlike) APIs. |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 VERSION |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Version 0.11 |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=cut |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our $VERSION = '0.11'; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 SYNOPSIS |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Net::Rest::Generic is a module for interacting with arbitrary HTTP/S APIs. |
28
|
|
|
|
|
|
|
It attempts to do this by providing an easy to read syntax for generating the request |
29
|
|
|
|
|
|
|
URLs on the fly, and generally Doing The Right Thing. |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
A basic example: |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
use Net::Rest::Generic; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
my $api = Net::Rest::Generic->new( |
36
|
|
|
|
|
|
|
host => "api.foo.com", |
37
|
|
|
|
|
|
|
scheme => "https", |
38
|
|
|
|
|
|
|
base => "api/v1", |
39
|
|
|
|
|
|
|
authorization_basic => { |
40
|
|
|
|
|
|
|
username => "user", |
41
|
|
|
|
|
|
|
password => "password", |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
); |
44
|
|
|
|
|
|
|
my $result = $api->setRequestMethod("POST")->this->is->the->url("parameterized")->addLabel("new"); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $details = $api->setRequestMethod("GET")->user("superUser")->details->color->favorite; |
47
|
|
|
|
|
|
|
... |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head2 new() |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
The new method is used to create a new() Net::Rest::Generic object. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=cut |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub new { |
58
|
11
|
|
|
11
|
1
|
7606
|
my $class = shift; |
59
|
11
|
|
|
|
|
49
|
my %defaults = ( |
60
|
|
|
|
|
|
|
mode => 'get', |
61
|
|
|
|
|
|
|
scheme => 'https', |
62
|
|
|
|
|
|
|
string => 0, |
63
|
|
|
|
|
|
|
); |
64
|
11
|
100
|
|
|
|
73
|
my $param_ref = ref($_[0]) ? $_[0] : {@_}; |
65
|
11
|
|
|
|
|
969
|
my $self = { |
66
|
|
|
|
|
|
|
chain => [], |
67
|
|
|
|
|
|
|
_params => dclone($param_ref), |
68
|
|
|
|
|
|
|
}; |
69
|
11
|
|
|
|
|
45
|
map { $self->{$_} = delete $self->{_params}{$_} } grep { defined($self->{_params}{$_}) } qw(mode scheme host port base string authorization_basic); |
|
55
|
|
|
|
|
163
|
|
|
77
|
|
|
|
|
188
|
|
70
|
11
|
|
|
|
|
65
|
while (my ($k, $v) = each %defaults) { |
71
|
33
|
|
100
|
|
|
165
|
$self->{$k} ||= $v; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
11
|
|
|
|
|
27
|
my $input; |
75
|
11
|
|
|
|
|
35
|
my @modes = qw(delete get post put head); |
76
|
11
|
100
|
|
|
|
181
|
if (! grep (/$self->{mode}/i, @modes)) { |
77
|
1
|
|
|
|
|
9
|
$input = Net::Rest::Generic::Error->throw( |
78
|
|
|
|
|
|
|
category => 'input', |
79
|
|
|
|
|
|
|
message => 'mode must be one of the following: ' . join(', ', @modes) . '. You supplied: ' . $self->{mode}, |
80
|
|
|
|
|
|
|
); |
81
|
|
|
|
|
|
|
} |
82
|
11
|
|
|
|
|
27
|
my @schemes = qw(http https); |
83
|
11
|
100
|
|
|
|
269
|
if (! grep (/$self->{scheme}/i, @schemes)) { |
84
|
1
|
|
|
|
|
14
|
$input = Net::Rest::Generic::Error->throw( |
85
|
|
|
|
|
|
|
category => 'input', |
86
|
|
|
|
|
|
|
message => 'scheme must be one of the following: ' . join(', ', @schemes) . '. You supplied: ' . $self->{scheme}, |
87
|
|
|
|
|
|
|
); |
88
|
|
|
|
|
|
|
} |
89
|
11
|
100
|
|
|
|
52
|
return $input if (ref($input) eq 'Net::Rest::Generic::Error'); |
90
|
|
|
|
|
|
|
|
91
|
9
|
|
|
|
|
66
|
$self->{uri} = URI->new(); |
92
|
9
|
|
|
|
|
39898
|
$self->{uri}->scheme($self->{scheme}); |
93
|
9
|
|
|
|
|
37724
|
$self->{uri}->host($self->{host}); |
94
|
9
|
100
|
|
|
|
1091
|
$self->{uri}->port($self->{port}) if exists $self->{port}; |
95
|
9
|
|
|
|
|
471
|
return bless $self, $class; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub AUTOLOAD { |
99
|
26
|
|
|
26
|
|
4984
|
my $self = shift; |
100
|
|
|
|
|
|
|
|
101
|
26
|
|
|
|
|
32
|
our $AUTOLOAD; |
102
|
26
|
|
|
|
|
118
|
my ($key) = $AUTOLOAD =~ /.*::([\w_]+)/o; |
103
|
26
|
50
|
|
|
|
71
|
return if ($key eq 'DESTROY'); |
104
|
|
|
|
|
|
|
|
105
|
26
|
|
|
|
|
33
|
push @{ $self->{chain} }, $key; |
|
26
|
|
|
|
|
66
|
|
106
|
26
|
|
|
|
|
36
|
my $args; |
107
|
26
|
50
|
|
|
|
61
|
if (ref($_[0])) { |
108
|
0
|
|
|
|
|
0
|
$args = $_[0]; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
else { |
111
|
26
|
|
|
|
|
34
|
push @{ $self->{chain} }, @_; |
|
26
|
|
|
|
|
49
|
|
112
|
|
|
|
|
|
|
} |
113
|
26
|
100
|
100
|
|
|
84
|
if (want('OBJECT') || want('VOID')) { |
114
|
20
|
|
|
|
|
1328
|
return $self; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
6
|
100
|
|
|
|
590
|
unshift(@{ $self->{chain} }, $self->{base}) if exists $self->{base}; |
|
4
|
|
|
|
|
12
|
|
118
|
6
|
|
|
|
|
9
|
my $url = join('/', @{ $self->{chain} }); |
|
6
|
|
|
|
|
20
|
|
119
|
6
|
|
|
|
|
18
|
$self->{chain} = []; |
120
|
6
|
|
|
|
|
46
|
$self->{uri}->path($url); |
121
|
|
|
|
|
|
|
|
122
|
6
|
100
|
|
|
|
268
|
if ($self->{string}) { |
123
|
4
|
100
|
|
|
|
16
|
if (want('LIST')) { |
124
|
2
|
|
|
|
|
94
|
return ($self->{mode}, $self->{uri}->as_string); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
else { |
127
|
2
|
|
|
|
|
106
|
return $self->{uri}->as_string; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
2
|
|
|
|
|
14
|
return Net::Rest::Generic::Utility::_doRestCall($self, $self->{mode}, $self->{uri}, $args); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head2 addLabel() |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
The addLabel method exists in case the rest url that you're using |
137
|
|
|
|
|
|
|
has a portion of it's path that has the same name as a method that isn't |
138
|
|
|
|
|
|
|
handled by the AUTOLOAD method in this module. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
usage: $api->addLabel("new"); |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=cut |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub addLabel { |
145
|
0
|
|
|
0
|
1
|
0
|
my ($self, @labels) = @_; |
146
|
0
|
|
|
|
|
0
|
push @{$self->{chain}}, @labels; |
|
0
|
|
|
|
|
0
|
|
147
|
0
|
|
|
|
|
0
|
return $self; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head2 cloneApi |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
The cloneApi function is used to make a hard copy of whatever object you're |
153
|
|
|
|
|
|
|
working on so that you can make a 'save point' of your object. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
usage my $cloneapi = $api->clone |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=cut |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub cloneApi { |
160
|
1
|
|
|
1
|
1
|
95
|
return dclone(shift); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head2 setRequestMethod() |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
The setRequestMethod function is used to change the method that the object |
166
|
|
|
|
|
|
|
will use when running the request. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
usage $api->setRequestMethod("POST")->...... |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=cut |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub setRequestMethod { |
173
|
0
|
|
|
0
|
1
|
0
|
my ($self, $method) = @_; |
174
|
0
|
|
|
|
|
0
|
$self->{mode} = $method; |
175
|
0
|
|
|
|
|
0
|
return $self; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head2 setRequestContent() |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
The setRequestContent method will allow you to send something specifically |
181
|
|
|
|
|
|
|
along in the HTTP::Request object when the call to the api is made. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
For instance you may want to send the api method you're about to use a json |
184
|
|
|
|
|
|
|
data structure, you could do: |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
$api->setRequestMethod($json)->methodthatrequiresjson |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=cut |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub setRequestContent { |
191
|
1
|
|
|
1
|
1
|
512
|
my ($self, $content) = @_; |
192
|
1
|
|
|
|
|
3
|
$self->{request_content} = $content; |
193
|
1
|
|
|
|
|
12
|
return $self; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head2 userAgentOptions() |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
The userAgentOptions method will allow you to send in a hash or hashref |
199
|
|
|
|
|
|
|
that will be used as the options for the LWP::UserAgent object used for |
200
|
|
|
|
|
|
|
making the api call. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
For example: |
203
|
|
|
|
|
|
|
$api->userAgentOptions(ssl_opts => {verify_hostname => 0}); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=cut |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub userAgentOptions { |
208
|
1
|
|
|
1
|
1
|
2762
|
my $self = shift; |
209
|
1
|
50
|
|
|
|
7
|
my $argref = ref($_[0]) ? $_[0] : {@_}; |
210
|
1
|
|
|
|
|
3
|
$self->{useragent_options} = $argref; |
211
|
1
|
|
|
|
|
3
|
return $self; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 AUTHORS |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Sebastian Green-Husted, C<< >> |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Shane Utt, C<< >> |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head1 BUGS |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through |
223
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
224
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=head1 SUPPORT |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
perldoc Net::Rest::Generic |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
You can also look for information at: |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=over 4 |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
L |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
L |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=item * CPAN Ratings |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
L |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item * Search CPAN |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
L |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=back |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
Copyright (C) 2013 Sebastian Green-Husted, All Rights Reserved. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
Copyright (C) 2013 Shane Utt, All Rights Reserved. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
261
|
|
|
|
|
|
|
under the terms of the the Artistic License (2.0). You may obtain a |
262
|
|
|
|
|
|
|
copy of the full license at: |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
L |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
Any use, modification, and distribution of the Standard or Modified |
267
|
|
|
|
|
|
|
Versions is governed by this Artistic License. By using, modifying or |
268
|
|
|
|
|
|
|
distributing the Package, you accept this license. Do not use, modify, |
269
|
|
|
|
|
|
|
or distribute the Package, if you do not accept this license. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
If your Modified Version has been derived from a Modified Version made |
272
|
|
|
|
|
|
|
by someone other than you, you are nevertheless required to ensure that |
273
|
|
|
|
|
|
|
your Modified Version complies with the requirements of this license. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
This license does not grant you the right to use any trademark, service |
276
|
|
|
|
|
|
|
mark, tradename, or logo of the Copyright Holder. |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
This license includes the non-exclusive, worldwide, free-of-charge |
279
|
|
|
|
|
|
|
patent license to make, have made, use, offer to sell, sell, import and |
280
|
|
|
|
|
|
|
otherwise transfer the Package with respect to any patent claims |
281
|
|
|
|
|
|
|
licensable by the Copyright Holder that are necessarily infringed by the |
282
|
|
|
|
|
|
|
Package. If you institute patent litigation (including a cross-claim or |
283
|
|
|
|
|
|
|
counterclaim) against any party alleging that the Package constitutes |
284
|
|
|
|
|
|
|
direct or contributory patent infringement, then this Artistic License |
285
|
|
|
|
|
|
|
to you shall terminate on the date that such litigation is filed. |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER |
288
|
|
|
|
|
|
|
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. |
289
|
|
|
|
|
|
|
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR |
290
|
|
|
|
|
|
|
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY |
291
|
|
|
|
|
|
|
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR |
292
|
|
|
|
|
|
|
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR |
293
|
|
|
|
|
|
|
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, |
294
|
|
|
|
|
|
|
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=cut |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
1; |