line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package OAuth::Lite::Consumer; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
15892
|
use strict; |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
168
|
|
4
|
4
|
|
|
4
|
|
23
|
use warnings; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
164
|
|
5
|
|
|
|
|
|
|
|
6
|
4
|
|
|
|
|
4562
|
use base qw( |
7
|
|
|
|
|
|
|
Class::ErrorHandler |
8
|
|
|
|
|
|
|
Class::Accessor::Fast |
9
|
4
|
|
|
4
|
|
20
|
); |
|
4
|
|
|
|
|
8
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors(qw( |
12
|
|
|
|
|
|
|
consumer_key |
13
|
|
|
|
|
|
|
consumer_secret |
14
|
|
|
|
|
|
|
oauth_request |
15
|
|
|
|
|
|
|
oauth_response |
16
|
|
|
|
|
|
|
request_token |
17
|
|
|
|
|
|
|
access_token |
18
|
|
|
|
|
|
|
)); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
*oauth_req = \&oauth_request; |
21
|
|
|
|
|
|
|
*oauth_res = \&oauth_response; |
22
|
|
|
|
|
|
|
|
23
|
4
|
|
|
4
|
|
18137
|
use Carp (); |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
69
|
|
24
|
4
|
|
|
4
|
|
5490
|
use bytes (); |
|
4
|
|
|
|
|
77
|
|
|
4
|
|
|
|
|
97
|
|
25
|
4
|
|
|
4
|
|
2917
|
use URI; |
|
4
|
|
|
|
|
25721
|
|
|
4
|
|
|
|
|
230
|
|
26
|
4
|
|
|
4
|
|
24851
|
use HTTP::Request; |
|
4
|
|
|
|
|
156375
|
|
|
4
|
|
|
|
|
526
|
|
27
|
4
|
|
|
4
|
|
38
|
use HTTP::Headers; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
177
|
|
28
|
4
|
|
|
4
|
|
7054
|
use UNIVERSAL::require; |
|
4
|
|
|
|
|
10454
|
|
|
4
|
|
|
|
|
51
|
|
29
|
4
|
|
|
4
|
|
5238
|
use List::MoreUtils qw(any); |
|
4
|
|
|
|
|
7802
|
|
|
4
|
|
|
|
|
385
|
|
30
|
|
|
|
|
|
|
|
31
|
4
|
|
|
4
|
|
3569
|
use OAuth::Lite; |
|
4
|
|
|
|
|
12
|
|
|
4
|
|
|
|
|
47
|
|
32
|
4
|
|
|
4
|
|
7662
|
use OAuth::Lite::Agent; |
|
4
|
|
|
|
|
17
|
|
|
4
|
|
|
|
|
64
|
|
33
|
4
|
|
|
4
|
|
2477
|
use OAuth::Lite::Token; |
|
4
|
|
|
|
|
15
|
|
|
4
|
|
|
|
|
49
|
|
34
|
4
|
|
|
4
|
|
2953
|
use OAuth::Lite::Response; |
|
4
|
|
|
|
|
12
|
|
|
4
|
|
|
|
|
37
|
|
35
|
4
|
|
|
4
|
|
157
|
use OAuth::Lite::Util qw(:all); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
782
|
|
36
|
4
|
|
|
4
|
|
3160
|
use OAuth::Lite::AuthMethod qw(:all); |
|
4
|
|
|
|
|
58
|
|
|
4
|
|
|
|
|
25721
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 NAME |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
OAuth::Lite::Consumer - consumer agent |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 SYNOPSIS |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $consumer = OAuth::Lite::Consumer->new( |
45
|
|
|
|
|
|
|
consumer_key => $consumer_key, |
46
|
|
|
|
|
|
|
consumer_secret => $consumer_secret, |
47
|
|
|
|
|
|
|
site => q{http://api.example.org}, |
48
|
|
|
|
|
|
|
request_token_path => q{/request_token}, |
49
|
|
|
|
|
|
|
access_token_path => q{/access_token}, |
50
|
|
|
|
|
|
|
authorize_path => q{http://example.org/authorize}, |
51
|
|
|
|
|
|
|
); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# At first you have to publish request-token, and |
54
|
|
|
|
|
|
|
# with it, redirect end-user to authorization-url that Service Provider tell you beforehand. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my $request_token = $consumer->get_request_token( |
57
|
|
|
|
|
|
|
callback_url => q{http://yourservice/callback}, |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
$your_app->session->set( request_token => $request_token ); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
$your_app->redirect( $consumer->url_to_authorize( |
63
|
|
|
|
|
|
|
token => $request_token, |
64
|
|
|
|
|
|
|
) ); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# After user authorize the request on a Service Provider side web application. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
my $verifier = $your_app->request->param('oauth_verifier'); |
69
|
|
|
|
|
|
|
my $request_token = $your_app->session->get('request_token'); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
my $access_token = $consumer->get_access_token( |
72
|
|
|
|
|
|
|
token => $request_token, |
73
|
|
|
|
|
|
|
verifier => $verifier, |
74
|
|
|
|
|
|
|
); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
$your_app->session->set( access_token => $access_token ); |
77
|
|
|
|
|
|
|
$your_app->session->remove('request_token'); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# After all, you can request protected-resources with access token |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
my $access_token = $your_app->session->get('access_token'); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
my $res = $consumer->request( |
84
|
|
|
|
|
|
|
method => 'GET', |
85
|
|
|
|
|
|
|
url => q{http://api.example.org/picture}, |
86
|
|
|
|
|
|
|
token => $access_token, |
87
|
|
|
|
|
|
|
params => { file => 'mypic.jpg', size => 'small' }, |
88
|
|
|
|
|
|
|
); |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
unless ($res->is_success) { |
91
|
|
|
|
|
|
|
if ($res->status == 400 || $res->status == 401) { |
92
|
|
|
|
|
|
|
my $auth_header = $res->header('WWW-Authenticate'); |
93
|
|
|
|
|
|
|
if ($auth_header && $auth_header =~ /^OAuth/) { |
94
|
|
|
|
|
|
|
# access token may be expired, |
95
|
|
|
|
|
|
|
# get request-token and authorize again |
96
|
|
|
|
|
|
|
} else { |
97
|
|
|
|
|
|
|
# another auth error. |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
# another error. |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# OAuth::Lite::Agent automatically adds Accept-Encoding gzip header to |
104
|
|
|
|
|
|
|
# request, so, when you use default agent, call decoded_content. |
105
|
|
|
|
|
|
|
my $resource = $res->decoded_content || $res->content; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
$your_app->handle_resource($resource); |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head1 DESCRIPTION |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
This module helps you to build OAuth Consumer application. |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head1 PAY ATTENTION |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
If you use OAuth 1.31 or older version, its has invalid way to normalize params. |
117
|
|
|
|
|
|
|
(when there are two or more same key and they contain ASCII and non ASCII value) |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
But the many services have already supported deprecated version, |
120
|
|
|
|
|
|
|
and the correct way breaks backward compatibility. |
121
|
|
|
|
|
|
|
So, from 1.32, supported both correct and deprecated method. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
use $OAuth::Lite::USE_DEPRECATED_NORMALIZER to switch behaviour. |
124
|
|
|
|
|
|
|
Currently 1 is set by default to keep backward compatibility. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
use OAuth::Lite::Consumer; |
127
|
|
|
|
|
|
|
use OAuth::Lite; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
$OAuth::Lite::USE_DEPRECATED_NORMALIZER = 0; |
130
|
|
|
|
|
|
|
... |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head1 METHODS |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head2 new(%args) |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head3 parameters |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=over 4 |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=item consumer_key |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
consumer_key value |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=item consumer_secret |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
consumer_secret value |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=item signature_method |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
Signature method you can choose from 'HMAC-SHA1', 'PLAINTEXT', and 'RSA-SHA1' (optional, 'HMAC-SHA1' is set by default) |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=item http_method |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
HTTP method (GET or POST) when the request is for request token or access token. (optional, 'POST' is set by default) |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=item auth_method |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
L's value you can choose from AUTH_HEADER, POST_BODY and URL_QUERY (optional, AUTH_HEADER is set by default) |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item realm |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
The OAuth realm value for a protected-resource you wanto to access to. (optional. empty-string is set by default) |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=item use_request_body_hash |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
If you use Request Body Hash extension, set 1. |
167
|
|
|
|
|
|
|
See Also L |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=item site |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
The base site url of Service Provider |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=item request_token_path |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=item access_token_path |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=item authorize_path |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=item callback_url |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=back |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Site and other paths, simple usage. |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
my $consumer = OAuth::Lite::Consumer->new( |
186
|
|
|
|
|
|
|
... |
187
|
|
|
|
|
|
|
site => q{http://example.org}, |
188
|
|
|
|
|
|
|
request_token_path => q{/request_token}, |
189
|
|
|
|
|
|
|
access_token_path => q{/access_token}, |
190
|
|
|
|
|
|
|
authorize_path => q{/authorize}, |
191
|
|
|
|
|
|
|
); |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
say $consumer->request_token_url; # http://example.org/request_token |
194
|
|
|
|
|
|
|
say $consumer->access_token_url; # http://example.org/access_token |
195
|
|
|
|
|
|
|
say $consumer->authorization_url; # http://example.org/authorize |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
If the authorization_url is run under another domain, for example. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
my $consumer = OAuth::Lite::Consumer->new( |
200
|
|
|
|
|
|
|
... |
201
|
|
|
|
|
|
|
site => q{http://api.example.org}, |
202
|
|
|
|
|
|
|
request_token_path => q{/request_token}, |
203
|
|
|
|
|
|
|
access_token_path => q{/access_token}, |
204
|
|
|
|
|
|
|
authorize_path => q{http://www.example.org/authorize}, |
205
|
|
|
|
|
|
|
); |
206
|
|
|
|
|
|
|
say $consumer->request_token_url; # http://api.example.org/request_token |
207
|
|
|
|
|
|
|
say $consumer->access_token_url; # http://api.example.org/access_token |
208
|
|
|
|
|
|
|
say $consumer->authorization_url; # http://www.example.org/authorize |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
Like this, if you pass absolute url, consumer uses them as it is. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
You can omit site param, if you pass all paths as absolute url. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
my $consumer = OAuth::Lite::Consumer->new( |
215
|
|
|
|
|
|
|
... |
216
|
|
|
|
|
|
|
request_token_path => q{http://api.example.org/request_token}, |
217
|
|
|
|
|
|
|
access_token_path => q{http://api.example.org/access_token}, |
218
|
|
|
|
|
|
|
authorize_path => q{http://www.example.org/authorize}, |
219
|
|
|
|
|
|
|
); |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
And there is a flexible way. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
# don't set each paths here. |
225
|
|
|
|
|
|
|
my $consumer = OAuth::Lite::Consumer->new( |
226
|
|
|
|
|
|
|
consumer_key => $consumer_key, |
227
|
|
|
|
|
|
|
consumer_secret => $consumer_secret, |
228
|
|
|
|
|
|
|
); |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# set request token url here directly |
231
|
|
|
|
|
|
|
my $rtoken = $consumer->get_request_token( |
232
|
|
|
|
|
|
|
url => q{http://api.example.org/request_token}, |
233
|
|
|
|
|
|
|
callback_url => q{http://www.yourservice/callback}, |
234
|
|
|
|
|
|
|
); |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
# set authorize path here directly |
237
|
|
|
|
|
|
|
my $url = $consumer->url_to_authorize( |
238
|
|
|
|
|
|
|
token => $rtoken, |
239
|
|
|
|
|
|
|
url => q{http://www.example.org/authorize}, |
240
|
|
|
|
|
|
|
); |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# set access token url here directly |
243
|
|
|
|
|
|
|
my $atoken = $consumer->get_access_token( |
244
|
|
|
|
|
|
|
url => q{http://api.example.org/access_token}, |
245
|
|
|
|
|
|
|
verifier => $verfication_code, |
246
|
|
|
|
|
|
|
); |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
So does callback_url. You can set it on consutructor or get_request_token method directly. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
my $consumer = OAuth::Lite::Consumer->new( |
251
|
|
|
|
|
|
|
... |
252
|
|
|
|
|
|
|
callback_url => q{http://www.yourservice/callback}, |
253
|
|
|
|
|
|
|
); |
254
|
|
|
|
|
|
|
... |
255
|
|
|
|
|
|
|
my $url = $consumer->get_request_token(); |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Or |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
my $consumer = OAuth::Lite::Consumer->new( |
260
|
|
|
|
|
|
|
... |
261
|
|
|
|
|
|
|
); |
262
|
|
|
|
|
|
|
... |
263
|
|
|
|
|
|
|
my $url = $consumer->get_request_token( |
264
|
|
|
|
|
|
|
callback_url => q{http://www.yourservice/callback}, |
265
|
|
|
|
|
|
|
); |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=cut |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
sub new { |
270
|
8
|
|
|
8
|
1
|
1191
|
my ($class, %args) = @_; |
271
|
8
|
|
|
|
|
23
|
my $ua = delete $args{ua}; |
272
|
8
|
50
|
|
|
|
30
|
unless ($ua) { |
273
|
8
|
|
|
|
|
66
|
$ua = OAuth::Lite::Agent->new; |
274
|
8
|
|
|
|
|
49
|
$ua->agent(join "/", __PACKAGE__, $OAuth::Lite::VERSION); |
275
|
|
|
|
|
|
|
} |
276
|
8
|
|
|
|
|
479
|
my $self = bless { |
277
|
|
|
|
|
|
|
ua => $ua, |
278
|
|
|
|
|
|
|
}, $class; |
279
|
8
|
|
|
|
|
45
|
$self->_init(%args); |
280
|
8
|
|
|
|
|
41
|
$self; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
sub _init { |
284
|
8
|
|
|
8
|
|
31
|
my ($self, %args) = @_; |
285
|
|
|
|
|
|
|
|
286
|
8
|
50
|
|
|
|
34
|
my $signature_method_class = exists $args{signature_method} |
287
|
|
|
|
|
|
|
? $args{signature_method} |
288
|
|
|
|
|
|
|
: 'HMAC_SHA1'; |
289
|
8
|
|
|
|
|
25
|
$signature_method_class =~ s/-/_/g; |
290
|
8
|
|
|
|
|
24
|
$signature_method_class = join('::', |
291
|
|
|
|
|
|
|
'OAuth::Lite::SignatureMethod', |
292
|
|
|
|
|
|
|
$signature_method_class |
293
|
|
|
|
|
|
|
); |
294
|
8
|
50
|
|
|
|
58
|
$signature_method_class->require |
295
|
|
|
|
|
|
|
or Carp::croak( |
296
|
|
|
|
|
|
|
sprintf |
297
|
|
|
|
|
|
|
qq/Could't find signature method class, %s/, |
298
|
|
|
|
|
|
|
$signature_method_class |
299
|
|
|
|
|
|
|
); |
300
|
|
|
|
|
|
|
|
301
|
8
|
|
100
|
|
|
282
|
$self->{consumer_key} = $args{consumer_key} || ''; |
302
|
8
|
|
100
|
|
|
37
|
$self->{consumer_secret} = $args{consumer_secret} || ''; |
303
|
8
|
|
100
|
|
|
47
|
$self->{http_method} = $args{http_method} || 'POST'; |
304
|
8
|
|
100
|
|
|
45
|
$self->{auth_method} = $args{auth_method} || AUTH_HEADER; |
305
|
8
|
50
|
|
|
|
55
|
unless ( OAuth::Lite::AuthMethod->validate_method( $self->{auth_method} ) ) { |
306
|
0
|
|
|
|
|
0
|
Carp::croak( sprintf |
307
|
|
|
|
|
|
|
qq/Invalid auth method "%s"./, $self->{auth_method} ); |
308
|
|
|
|
|
|
|
} |
309
|
8
|
|
|
|
|
35
|
$self->{signature_method} = $signature_method_class; |
310
|
8
|
|
|
|
|
19
|
$self->{realm} = $args{realm}; |
311
|
8
|
|
|
|
|
21
|
$self->{site} = $args{site}; |
312
|
8
|
|
|
|
|
17
|
$self->{request_token_path} = $args{request_token_path}; |
313
|
8
|
|
|
|
|
15
|
$self->{access_token_path} = $args{access_token_path}; |
314
|
8
|
|
|
|
|
12
|
$self->{authorize_path} = $args{authorize_path}; |
315
|
8
|
|
|
|
|
15
|
$self->{callback_url} = $args{callback_url}; |
316
|
8
|
|
|
|
|
17
|
$self->{oauth_request} = undef; |
317
|
8
|
|
|
|
|
14
|
$self->{oauth_response} = undef; |
318
|
8
|
50
|
|
|
|
27
|
$self->{use_request_body_hash} = $args{use_request_body_hash} ? 1 : 0; |
319
|
8
|
|
|
|
|
25
|
$self->{_nonce} = $args{_nonce}; |
320
|
8
|
|
|
|
|
29
|
$self->{_timestamp} = $args{_timestamp}; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=head2 request_token_url |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=cut |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
sub request_token_url { |
328
|
3
|
|
|
3
|
1
|
14
|
my $self = shift; |
329
|
3
|
100
|
|
|
|
27
|
$self->{request_token_path} =~ m!^http(?:s)?\://! |
330
|
|
|
|
|
|
|
? $self->{request_token_path} |
331
|
|
|
|
|
|
|
: sprintf q{%s%s}, $self->{site}, $self->{request_token_path}; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=head2 access_token_url |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=cut |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
sub access_token_url { |
340
|
3
|
|
|
3
|
1
|
6
|
my $self = shift; |
341
|
3
|
100
|
|
|
|
24
|
$self->{access_token_path} =~ m!^http(?:s)?\://! |
342
|
|
|
|
|
|
|
? $self->{access_token_path} |
343
|
|
|
|
|
|
|
: sprintf q{%s%s}, $self->{site}, $self->{access_token_path}; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
=head2 authorization_url |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=cut |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
sub authorization_url { |
351
|
8
|
|
|
8
|
1
|
15
|
my $self = shift; |
352
|
8
|
100
|
|
|
|
62
|
$self->{authorize_path} =~ m!^http(?:s)?\://! |
353
|
|
|
|
|
|
|
? $self->{authorize_path} |
354
|
|
|
|
|
|
|
: sprintf q{%s%s}, $self->{site}, $self->{authorize_path}; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
=head2 url_to_authorize(%params) |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=head3 parameters |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=over 4 |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=item url |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
authorization url, you can omit this if you set authorization_path on constructor. |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=item token |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
request token value |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=back |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
my $url = $consumer->url_to_authorize( |
375
|
|
|
|
|
|
|
url => q{http://example.org/authorize}, |
376
|
|
|
|
|
|
|
token => $request_token, |
377
|
|
|
|
|
|
|
callback_url => q{http://www.yousrservice/callback}, |
378
|
|
|
|
|
|
|
); |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=cut |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
sub url_to_authorize { |
383
|
5
|
|
|
5
|
1
|
1183
|
my ($self, %args) = @_; |
384
|
5
|
|
33
|
|
|
32
|
$args{url} ||= $self->authorization_url; |
385
|
5
|
50
|
|
|
|
18
|
my $url = $args{url} |
386
|
|
|
|
|
|
|
or Carp::croak qq/url_to_authorize needs url./; |
387
|
5
|
|
|
|
|
9
|
my %params = (); |
388
|
5
|
100
|
|
|
|
17
|
if (defined $args{token}) { |
389
|
3
|
|
|
|
|
5
|
my $token = $args{token}; |
390
|
3
|
100
|
|
|
|
5
|
$params{oauth_token} = ( eval { $token->isa('OAuth::Lite::Token') } ) |
|
3
|
|
|
|
|
40
|
|
391
|
|
|
|
|
|
|
? $token->token |
392
|
|
|
|
|
|
|
: $token; |
393
|
|
|
|
|
|
|
} |
394
|
5
|
|
|
|
|
41
|
$url = URI->new($url); |
395
|
5
|
|
|
|
|
12679
|
$url->query_form(%params); |
396
|
5
|
|
|
|
|
441
|
$url->as_string; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=head2 obtain_request_token(%params) |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
Returns a request token as an L object. |
402
|
|
|
|
|
|
|
Except for that, this method behaves same as get_request_token. |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
=cut |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
sub obtain_request_token { |
407
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
408
|
0
|
|
|
|
|
0
|
my $res = $self->_get_request_token(@_); |
409
|
0
|
0
|
|
|
|
0
|
unless ($res->is_success) { |
410
|
0
|
|
|
|
|
0
|
return $self->error($res->status_line); |
411
|
|
|
|
|
|
|
} |
412
|
0
|
|
0
|
|
|
0
|
my $resp = OAuth::Lite::Response->from_encoded($res->decoded_content||$res->content); |
413
|
0
|
0
|
0
|
|
|
0
|
return $self->error(qq/oauth_callback_confirmed is not true/) |
|
|
|
0
|
|
|
|
|
414
|
|
|
|
|
|
|
unless $resp && $resp->token && $resp->token->callback_confirmed; |
415
|
0
|
|
|
|
|
0
|
$self->request_token($resp->token); |
416
|
0
|
|
|
|
|
0
|
$resp; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=head2 get_request_token(%params) |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
Returns a request token as an L object. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=head3 parameters |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=over 4 |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=item url |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
Request token url. You can omit this if you set request_token_path on constructor |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=item realm |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
Realm for the resource you want to access to. |
434
|
|
|
|
|
|
|
You can omit this if you set realm on constructor. |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=item callback_url |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
Url which service provider redirect end-user to after authorization. |
439
|
|
|
|
|
|
|
You can omit this if you set callback_url on constructor. |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=back |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
my $token = $consumer->get_request_token( |
444
|
|
|
|
|
|
|
url => q{http://api.example.org/request_token}, |
445
|
|
|
|
|
|
|
realm => q{http://api.example.org/picture}, |
446
|
|
|
|
|
|
|
) or die $consumer->errstr; |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
say $token->token; |
449
|
|
|
|
|
|
|
say $token->secret; |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=cut |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
sub get_request_token { |
454
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
455
|
0
|
|
|
|
|
0
|
my $res = $self->_get_request_token(@_); |
456
|
0
|
0
|
|
|
|
0
|
unless ($res->is_success) { |
457
|
0
|
|
|
|
|
0
|
return $self->error($res->status_line); |
458
|
|
|
|
|
|
|
} |
459
|
0
|
|
0
|
|
|
0
|
my $token = OAuth::Lite::Token->from_encoded($res->decoded_content||$res->content); |
460
|
0
|
0
|
0
|
|
|
0
|
return $self->error(qq/oauth_callback_confirmed is not true/) |
461
|
|
|
|
|
|
|
unless $token && $token->callback_confirmed; |
462
|
0
|
|
|
|
|
0
|
$self->request_token($token); |
463
|
0
|
|
|
|
|
0
|
$token; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
sub _get_request_token { |
467
|
0
|
|
|
0
|
|
0
|
my ($self, %args) = @_; |
468
|
0
|
|
0
|
|
|
0
|
$args{url} ||= $self->request_token_url; |
469
|
0
|
0
|
|
|
|
0
|
my $request_token_url = delete $args{url} |
470
|
|
|
|
|
|
|
or Carp::croak qq/get_request_token needs url in hash params |
471
|
|
|
|
|
|
|
or set request_token_path on constructor./; |
472
|
0
|
|
0
|
|
|
0
|
my $realm = delete $args{realm} || $self->{realm} || ''; |
473
|
0
|
|
0
|
|
|
0
|
my $callback = delete $args{callback_url} || $self->{callback_url} || 'oob'; |
474
|
0
|
|
|
|
|
0
|
my $res = $self->__request( |
475
|
|
|
|
|
|
|
realm => $realm, |
476
|
|
|
|
|
|
|
url => $request_token_url, |
477
|
|
|
|
|
|
|
params => {%args, oauth_callback => $callback}, |
478
|
|
|
|
|
|
|
); |
479
|
0
|
|
|
|
|
0
|
return $res; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=head2 obtain_access_token |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
my $res = $consumer->obtain_access_token( |
485
|
|
|
|
|
|
|
url => $access_token_url, |
486
|
|
|
|
|
|
|
params => { |
487
|
|
|
|
|
|
|
x_auth_username => "myname", |
488
|
|
|
|
|
|
|
x_auth_password => "mypass", |
489
|
|
|
|
|
|
|
x_auth_mode => "client_auth", |
490
|
|
|
|
|
|
|
}, |
491
|
|
|
|
|
|
|
); |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
my $access_token = $res->token; |
494
|
|
|
|
|
|
|
say $acces_token->token; |
495
|
|
|
|
|
|
|
say $acces_token->secret; |
496
|
|
|
|
|
|
|
my $expires = $res->param('x_auth_expires'); |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
What is the difference between obtain_access_token and get_access_token? |
499
|
|
|
|
|
|
|
get_access_token requires token and verifier. |
500
|
|
|
|
|
|
|
obtain_access_token doesn't. these parameters are optional. |
501
|
|
|
|
|
|
|
You can pass extra parameters like above example.(see x_auth_XXX parameters) |
502
|
|
|
|
|
|
|
And get_access_token returns OAuth::Lite::Token object directly, |
503
|
|
|
|
|
|
|
obtain_access_token returns OAuth::Lite::Response object that includes |
504
|
|
|
|
|
|
|
not only Token object but also other response parameters. |
505
|
|
|
|
|
|
|
the extra parameters are used for some extensions.(Session extension, xAuth, etc.) |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
Of cource, if you don't need to handle these extensions, |
508
|
|
|
|
|
|
|
You can continue to use get_access_token for backward compatibility. |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
my $token = $consumer->get_access_token( |
511
|
|
|
|
|
|
|
url => $access_token_url, |
512
|
|
|
|
|
|
|
token => $request_token, |
513
|
|
|
|
|
|
|
verifier => $verification_code, |
514
|
|
|
|
|
|
|
); |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
# above code's behavior is same as (but response objects are different) |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
my $res = $consumer->obtain_access_token( |
519
|
|
|
|
|
|
|
url => $access_token_url, |
520
|
|
|
|
|
|
|
token => $request_token, |
521
|
|
|
|
|
|
|
params => { |
522
|
|
|
|
|
|
|
oauth_verifier => $verification_code, |
523
|
|
|
|
|
|
|
}, |
524
|
|
|
|
|
|
|
); |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=cut |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
sub obtain_access_token { |
529
|
0
|
|
|
0
|
1
|
0
|
my ($self, %args) = @_; |
530
|
0
|
|
0
|
|
|
0
|
$args{url} ||= $self->access_token_url; |
531
|
0
|
0
|
|
|
|
0
|
my $access_token_url = $args{url} |
532
|
|
|
|
|
|
|
or Carp::croak qq/get_access_token needs access_token_url./; |
533
|
0
|
|
0
|
|
|
0
|
my $realm = $args{realm} || $self->{realm} || ''; |
534
|
|
|
|
|
|
|
|
535
|
0
|
0
|
|
|
|
0
|
my $token = defined $args{token} ? $args{token} : undef; |
536
|
0
|
|
0
|
|
|
0
|
my $params = $args{params} || {}; |
537
|
|
|
|
|
|
|
|
538
|
0
|
|
|
|
|
0
|
my $res = $self->__request( |
539
|
|
|
|
|
|
|
realm => $realm, |
540
|
|
|
|
|
|
|
url => $access_token_url, |
541
|
|
|
|
|
|
|
token => $token, |
542
|
|
|
|
|
|
|
params => $params, |
543
|
|
|
|
|
|
|
); |
544
|
0
|
0
|
|
|
|
0
|
unless ($res->is_success) { |
545
|
0
|
|
|
|
|
0
|
return $self->error($res->status_line); |
546
|
|
|
|
|
|
|
} |
547
|
0
|
|
0
|
|
|
0
|
my $resp = OAuth::Lite::Response->from_encoded($res->decoded_content||$res->content); |
548
|
0
|
|
|
|
|
0
|
$self->access_token($resp->token); |
549
|
0
|
|
|
|
|
0
|
$resp; |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
=head2 get_access_token(%params) |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
Returns a access token as an L object. |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
=head3 parameters |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=over 4 |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
=item url |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
Request token url. You can omit this if you set request_token_path on constructor |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
=item realm |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
Realm for the resource you want to access to. |
568
|
|
|
|
|
|
|
You can omit this if you set realm on constructor. |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=item token |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
Request token object. |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=item verifier |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
Verfication code which provider returns. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=back |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
my $token = $consumer->get_access_token( |
581
|
|
|
|
|
|
|
url => q{http://api.example.org/request_token}, |
582
|
|
|
|
|
|
|
realm => q{http://api.example.org/picture}, |
583
|
|
|
|
|
|
|
token => $request_token, |
584
|
|
|
|
|
|
|
verifier => $verification_code, |
585
|
|
|
|
|
|
|
) or die $consumer->errstr; |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
say $token->token; |
588
|
|
|
|
|
|
|
say $token->secret; |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
=cut |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
sub get_access_token { |
594
|
0
|
|
|
0
|
1
|
0
|
my ($self, %args) = @_; |
595
|
0
|
|
0
|
|
|
0
|
$args{url} ||= $self->access_token_url; |
596
|
0
|
0
|
|
|
|
0
|
my $access_token_url = $args{url} |
597
|
|
|
|
|
|
|
or Carp::croak qq/get_access_token needs access_token_url./; |
598
|
0
|
0
|
|
|
|
0
|
my $token = defined $args{token} ? $args{token} : $self->request_token; |
599
|
0
|
0
|
|
|
|
0
|
Carp::croak qq/get_access_token needs token./ unless defined $token; |
600
|
0
|
|
0
|
|
|
0
|
my $realm = $args{realm} || $self->{realm} || ''; |
601
|
0
|
0
|
|
|
|
0
|
my $verifier = $args{verifier} |
602
|
|
|
|
|
|
|
or Carp::croak qq/verfier not found./; |
603
|
0
|
|
|
|
|
0
|
my $res = $self->__request( |
604
|
|
|
|
|
|
|
realm => $realm, |
605
|
|
|
|
|
|
|
url => $access_token_url, |
606
|
|
|
|
|
|
|
token => $token, |
607
|
|
|
|
|
|
|
params => { oauth_verifier => $verifier }, |
608
|
|
|
|
|
|
|
); |
609
|
0
|
0
|
|
|
|
0
|
unless ($res->is_success) { |
610
|
0
|
|
|
|
|
0
|
return $self->error($res->status_line); |
611
|
|
|
|
|
|
|
} |
612
|
0
|
|
0
|
|
|
0
|
my $access_token = OAuth::Lite::Token->from_encoded($res->decoded_content||$res->content); |
613
|
0
|
|
|
|
|
0
|
$self->access_token($access_token); |
614
|
0
|
|
|
|
|
0
|
$access_token; |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
=head2 gen_oauth_request(%args) |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
Returns L object. |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
my $req = $consumer->gen_oauth_request( |
622
|
|
|
|
|
|
|
method => 'GET', |
623
|
|
|
|
|
|
|
url => 'http://example.com/', |
624
|
|
|
|
|
|
|
headers => [ Accept => q{...}, 'Content-Type' => q{...}, ... ], |
625
|
|
|
|
|
|
|
content => $content, |
626
|
|
|
|
|
|
|
realm => $realm, |
627
|
|
|
|
|
|
|
token => $token, |
628
|
|
|
|
|
|
|
params => { file => 'mypic.jpg', size => 'small' }, |
629
|
|
|
|
|
|
|
); |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
=cut |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
sub gen_oauth_request { |
634
|
|
|
|
|
|
|
|
635
|
2
|
|
|
2
|
1
|
709
|
my ($self, %args) = @_; |
636
|
|
|
|
|
|
|
|
637
|
2
|
|
66
|
|
|
11
|
my $method = $args{method} || $self->{http_method}; |
638
|
2
|
|
|
|
|
4
|
my $url = $args{url}; |
639
|
2
|
|
|
|
|
5
|
my $content = $args{content}; |
640
|
2
|
|
|
|
|
5
|
my $token = $args{token}; |
641
|
2
|
|
50
|
|
|
7
|
my $extra = $args{params} || {}; |
642
|
2
|
|
50
|
|
|
23
|
my $realm = $args{realm} |
643
|
|
|
|
|
|
|
|| $self->{realm} |
644
|
|
|
|
|
|
|
|| $self->find_realm_from_last_response |
645
|
|
|
|
|
|
|
|| ''; |
646
|
|
|
|
|
|
|
|
647
|
2
|
100
|
|
|
|
39
|
if (ref $extra eq 'ARRAY') { |
648
|
1
|
|
|
|
|
3
|
my %hash; |
649
|
1
|
|
|
|
|
6
|
for (0...scalar(@$extra)/2-1) { |
650
|
7
|
|
|
|
|
12
|
my $key = $extra->[$_ * 2]; |
651
|
7
|
|
|
|
|
13
|
my $value = $extra->[$_ * 2 + 1]; |
652
|
7
|
|
100
|
|
|
71
|
$hash{$key} ||= []; |
653
|
7
|
|
|
|
|
8
|
push @{ $hash{$key} }, $value; |
|
7
|
|
|
|
|
19
|
|
654
|
|
|
|
|
|
|
} |
655
|
1
|
|
|
|
|
3
|
$extra = \%hash; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
2
|
|
|
|
|
5
|
my $headers = $args{headers}; |
659
|
2
|
50
|
|
|
|
7
|
if (defined $headers) { |
660
|
0
|
0
|
|
|
|
0
|
if (ref($headers) eq 'ARRAY') { |
661
|
0
|
|
|
|
|
0
|
$headers = HTTP::Headers->new(@$headers); |
662
|
|
|
|
|
|
|
} else { |
663
|
0
|
|
|
|
|
0
|
$headers = $headers->clone; |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
} else { |
666
|
2
|
|
|
|
|
25
|
$headers = HTTP::Headers->new; |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
2
|
|
|
|
|
20
|
my @send_data_methods = qw/POST PUT/; |
670
|
2
|
|
|
|
|
6
|
my @non_send_data_methods = qw/GET HEAD DELETE/; |
671
|
|
|
|
|
|
|
|
672
|
2
|
|
|
3
|
|
13
|
my $is_send_data_method = any { $method eq $_ } @send_data_methods; |
|
3
|
|
|
|
|
7
|
|
673
|
|
|
|
|
|
|
|
674
|
2
|
|
|
|
|
9
|
my $auth_method = $self->{auth_method}; |
675
|
2
|
50
|
66
|
|
|
25
|
$auth_method = AUTH_HEADER |
676
|
|
|
|
|
|
|
if ( !$is_send_data_method && $auth_method eq POST_BODY ); |
677
|
|
|
|
|
|
|
|
678
|
2
|
50
|
|
|
|
12
|
if ($auth_method eq URL_QUERY) { |
|
|
50
|
|
|
|
|
|
679
|
0
|
0
|
0
|
|
|
0
|
if ( $is_send_data_method && !$content ) { |
680
|
0
|
|
|
|
|
0
|
Carp::croak |
681
|
|
|
|
|
|
|
qq(You must set content-body in case you use combination of URL_QUERY and POST/PUT http method); |
682
|
|
|
|
|
|
|
} else { |
683
|
0
|
0
|
|
|
|
0
|
if ( $is_send_data_method ) { |
684
|
0
|
0
|
|
|
|
0
|
if ( my $hash = $self->build_body_hash($content) ) { |
685
|
0
|
|
|
|
|
0
|
$extra->{oauth_body_hash} = $hash; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
} |
688
|
0
|
|
|
|
|
0
|
my $query = $self->gen_auth_query($method, $url, $token, $extra); |
689
|
0
|
|
|
|
|
0
|
$url = sprintf q{%s?%s}, $url, $query; |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
} elsif ($auth_method eq POST_BODY) { |
692
|
0
|
|
|
|
|
0
|
my $query = $self->gen_auth_query($method, $url, $token, $extra); |
693
|
0
|
|
|
|
|
0
|
$content = $query; |
694
|
0
|
|
|
|
|
0
|
$headers->header('Content-Type', q{application/x-www-form-urlencoded}); |
695
|
|
|
|
|
|
|
} else { |
696
|
2
|
|
|
|
|
6
|
my $origin_url = $url; |
697
|
2
|
|
|
|
|
6
|
my $copied_params = {}; |
698
|
2
|
|
|
|
|
20
|
for my $param_key ( keys %$extra ) { |
699
|
5
|
100
|
|
|
|
23
|
next if $param_key =~ /^x?oauth_/; |
700
|
4
|
|
|
|
|
12
|
$copied_params->{$param_key} = $extra->{$param_key}; |
701
|
|
|
|
|
|
|
} |
702
|
2
|
100
|
|
|
|
82
|
if ( keys %$copied_params > 0 ) { |
703
|
1
|
|
|
|
|
7
|
my $data = normalize_params($copied_params); |
704
|
1
|
50
|
33
|
|
|
9
|
if ( $is_send_data_method && !$content ) { |
705
|
0
|
|
|
|
|
0
|
$content = $data; |
706
|
|
|
|
|
|
|
} else { |
707
|
1
|
|
|
|
|
5
|
$url = sprintf q{%s?%s}, $url, $data; |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
} |
710
|
2
|
100
|
|
|
|
9
|
if ( $is_send_data_method ) { |
711
|
1
|
50
|
|
|
|
4
|
if ( my $hash = $self->build_body_hash($content) ) { |
712
|
0
|
|
|
|
|
0
|
$extra->{oauth_body_hash} = $hash; |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
} |
715
|
2
|
|
|
|
|
18
|
my $header = $self->gen_auth_header($method, $origin_url, |
716
|
|
|
|
|
|
|
{ realm => $realm, token => $token, extra => $extra }); |
717
|
2
|
|
|
|
|
20
|
$headers->header( Authorization => $header ); |
718
|
|
|
|
|
|
|
} |
719
|
2
|
100
|
|
|
|
135
|
if ( $is_send_data_method ) { |
720
|
1
|
50
|
|
|
|
4
|
$headers->header('Content-Type', q{application/x-www-form-urlencoded}) |
721
|
|
|
|
|
|
|
unless $headers->header('Content-Type'); |
722
|
1
|
|
50
|
|
|
67
|
$headers->header('Content-Length', bytes::length($content) || 0 ); |
723
|
|
|
|
|
|
|
} |
724
|
2
|
|
|
|
|
1313
|
my $req = HTTP::Request->new( $method, $url, $headers, $content ); |
725
|
2
|
|
|
|
|
727
|
$req; |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
=head2 request(%params) |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
Returns L object. |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=head3 parameters |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=over 4 |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
=item realm |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
Realm for a resource you want to access |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=item token |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
Access token L object |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
=item method |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
HTTP method. |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=item url |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
Request URL |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=item parmas |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
Extra params. |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=item content |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
body data sent when method is POST or PUT. |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=back |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
my $response = $consumer->request( |
763
|
|
|
|
|
|
|
method => 'POST', |
764
|
|
|
|
|
|
|
url => 'http://api.example.com/picture', |
765
|
|
|
|
|
|
|
headers => [ Accept => q{...}, 'Content-Type' => q{...}, ... ], |
766
|
|
|
|
|
|
|
content => $content, |
767
|
|
|
|
|
|
|
realm => $realm, |
768
|
|
|
|
|
|
|
token => $access_token, |
769
|
|
|
|
|
|
|
params => { file => 'mypic.jpg', size => 'small' }, |
770
|
|
|
|
|
|
|
); |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
unless ($response->is_success) { |
773
|
|
|
|
|
|
|
... |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
=cut |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
sub request { |
779
|
0
|
|
|
0
|
1
|
0
|
my ($self, %args) = @_; |
780
|
0
|
|
0
|
|
|
0
|
$args{token} ||= $self->access_token; |
781
|
0
|
|
|
|
|
0
|
$self->__request(%args); |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
sub __request { |
785
|
0
|
|
|
0
|
|
0
|
my ($self, %args) = @_; |
786
|
0
|
|
|
|
|
0
|
my $req = $self->gen_oauth_request(%args); |
787
|
0
|
|
|
|
|
0
|
$self->oauth_clear(); |
788
|
0
|
|
|
|
|
0
|
$self->oauth_request($req); |
789
|
0
|
|
|
|
|
0
|
my $res = $self->{ua}->request($req); |
790
|
0
|
|
|
|
|
0
|
$self->oauth_response($res); |
791
|
0
|
|
|
|
|
0
|
$res; |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=head2 get |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
There are simple methods to request protected resources. |
797
|
|
|
|
|
|
|
You need to obtain access token and set it to consumer beforehand. |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
my $access_token = $consumer->get_access_token( |
800
|
|
|
|
|
|
|
token => $request_token, |
801
|
|
|
|
|
|
|
verifier => $verifier, |
802
|
|
|
|
|
|
|
); |
803
|
|
|
|
|
|
|
# when successfully got an access-token, |
804
|
|
|
|
|
|
|
# it internally execute saving method like following line. |
805
|
|
|
|
|
|
|
# $consumer->access_token( $access_token ) |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
or |
808
|
|
|
|
|
|
|
my $access_token = $your_app->pick_up_saved_access_token(); |
809
|
|
|
|
|
|
|
$consumer->access_token($access_token); |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
Then you can access protected resource in a simple way. |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
my $res = $consumer->get( 'http://api.example.com/pictures' ); |
814
|
|
|
|
|
|
|
if ($res->is_success) { |
815
|
|
|
|
|
|
|
say $res->decoded_content||$res->content; |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
This is same as |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
my $res = $consumer->request( |
821
|
|
|
|
|
|
|
method => q{GET}, |
822
|
|
|
|
|
|
|
url => q{http://api.example.com/picture}, |
823
|
|
|
|
|
|
|
); |
824
|
|
|
|
|
|
|
if ($res->is_success) { |
825
|
|
|
|
|
|
|
say $res->decoded_content||$res->content; |
826
|
|
|
|
|
|
|
} |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
=cut |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
sub get { |
831
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $url, $args ) = @_; |
832
|
0
|
|
0
|
|
|
0
|
$args ||= {}; |
833
|
0
|
|
|
|
|
0
|
$args->{method} = 'GET'; |
834
|
0
|
|
|
|
|
0
|
$args->{url} = $url; |
835
|
0
|
|
|
|
|
0
|
$self->request(%$args); |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
=head2 post |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
$res = $consumer->post( 'http://api.example.com/pictures', $content ); |
841
|
|
|
|
|
|
|
if ($res->is_success) { |
842
|
|
|
|
|
|
|
... |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
This is same as |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
$res = $consumer->request( |
848
|
|
|
|
|
|
|
method => q{POST}, |
849
|
|
|
|
|
|
|
url => q{http://api.example.com/picture}, |
850
|
|
|
|
|
|
|
content => $content, |
851
|
|
|
|
|
|
|
); |
852
|
|
|
|
|
|
|
if ($res->is_success) { |
853
|
|
|
|
|
|
|
... |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=cut |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
sub post { |
860
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $url, $content, $args ) = @_; |
861
|
0
|
|
0
|
|
|
0
|
$args ||= {}; |
862
|
0
|
|
|
|
|
0
|
$args->{method} = 'POST'; |
863
|
0
|
|
|
|
|
0
|
$args->{url} = $url; |
864
|
0
|
|
|
|
|
0
|
$args->{content} = $content; |
865
|
0
|
|
|
|
|
0
|
$self->request(%$args); |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
} |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=head2 put |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
$res = $consumer->put( 'http://api.example.com/pictures', $content ); |
872
|
|
|
|
|
|
|
if ($res->is_success) { |
873
|
|
|
|
|
|
|
... |
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
This is same as |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
my $res = $consumer->request( |
879
|
|
|
|
|
|
|
method => q{PUT}, |
880
|
|
|
|
|
|
|
url => q{http://api.example.com/picture}, |
881
|
|
|
|
|
|
|
content => $content, |
882
|
|
|
|
|
|
|
); |
883
|
|
|
|
|
|
|
if ($res->is_success) { |
884
|
|
|
|
|
|
|
... |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
=cut |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
sub put { |
891
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $url, $content, $args ) = @_; |
892
|
0
|
|
0
|
|
|
0
|
$args ||= {}; |
893
|
0
|
|
|
|
|
0
|
$args->{method} = 'PUT'; |
894
|
0
|
|
|
|
|
0
|
$args->{url} = $url; |
895
|
0
|
|
|
|
|
0
|
$args->{content} = $content; |
896
|
0
|
|
|
|
|
0
|
$self->request(%$args); |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=head2 delete |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
my $res = $consumer->delete('http://api.example.com/delete'); |
903
|
|
|
|
|
|
|
if ($res->is_success) { |
904
|
|
|
|
|
|
|
... |
905
|
|
|
|
|
|
|
} |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
This is same as |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
my $res = $consumer->request( |
910
|
|
|
|
|
|
|
method => q{DELETE}, |
911
|
|
|
|
|
|
|
url => q{http://api.example.com/picture}, |
912
|
|
|
|
|
|
|
); |
913
|
|
|
|
|
|
|
if ($res->is_success) { |
914
|
|
|
|
|
|
|
... |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=cut |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
sub delete { |
920
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $url, $args ) = @_; |
921
|
0
|
|
0
|
|
|
0
|
$args ||= {}; |
922
|
0
|
|
|
|
|
0
|
$args->{method} = 'DELETE'; |
923
|
0
|
|
|
|
|
0
|
$args->{url} = $url; |
924
|
0
|
|
|
|
|
0
|
$self->request(%$args); |
925
|
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
=head2 find_realm_from_last_response |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
=cut |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
sub find_realm_from_last_response { |
932
|
2
|
|
|
2
|
1
|
7
|
my $self = shift; |
933
|
2
|
50
|
|
|
|
18
|
return unless $self->oauth_response; |
934
|
0
|
|
|
|
|
0
|
my $authenticate = $self->oauth_response->header('WWW-Authenticate'); |
935
|
0
|
0
|
0
|
|
|
0
|
return unless ($authenticate && $authenticate =~ /^\s*OAuth/); |
936
|
0
|
|
|
|
|
0
|
my $realm = parse_auth_header($authenticate); |
937
|
0
|
|
|
|
|
0
|
$realm; |
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
=head2 gen_auth_header($http_method, $request_url, $params); |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
=head3 parameters |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=over 4 |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
=item realm |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
realm for a resource you want to access |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
=item token |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
OAuth::Lite::Token object(optional) |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
=back |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
my $header = $consumer->gen_auth_header($method, $url, { |
957
|
|
|
|
|
|
|
realm => $realm, |
958
|
|
|
|
|
|
|
token => $token, |
959
|
|
|
|
|
|
|
}); |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
=cut |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
sub gen_auth_header { |
964
|
2
|
|
|
2
|
1
|
5
|
my ($self, $method, $url, $args) = @_; |
965
|
2
|
|
50
|
|
|
10
|
my $extra = $args->{extra} || {}; |
966
|
2
|
|
|
|
|
12
|
my $params = $self->gen_auth_params($method, $url, $args->{token}, $extra); |
967
|
2
|
|
50
|
|
|
21
|
my $realm = $args->{realm} || ''; |
968
|
2
|
|
|
|
|
13
|
my $authorization_header = build_auth_header($realm, $params); |
969
|
2
|
|
|
|
|
12
|
$authorization_header; |
970
|
|
|
|
|
|
|
} |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
=head2 gen_auth_query($http_method, $ruqest_url, $token, $extra) |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=cut |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
sub gen_auth_query { |
977
|
4
|
|
|
4
|
1
|
4643
|
my ($self, $method, $url, $token, $extra) = @_; |
978
|
4
|
|
100
|
|
|
22
|
$extra ||= {}; |
979
|
4
|
|
|
|
|
14
|
my $params = $self->gen_auth_params($method, $url, $token, $extra); |
980
|
4
|
|
|
|
|
31
|
my %all = (%$extra, %$params); |
981
|
4
|
|
|
|
|
32
|
normalize_params({%all}); |
982
|
|
|
|
|
|
|
} |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
=head2 gen_auth_params($http_method, $request_url, [$token]) |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
Generates and returns all oauth params. |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
my $params = $consumer->gen_auth_params($http_method, $request_url); |
989
|
|
|
|
|
|
|
say $params->{oauth_consumer_key}; |
990
|
|
|
|
|
|
|
say $params->{oauth_timestamp}; |
991
|
|
|
|
|
|
|
say $params->{oauth_nonce}; |
992
|
|
|
|
|
|
|
say $params->{oauth_signature_method}; |
993
|
|
|
|
|
|
|
say $params->{oauth_signature}; |
994
|
|
|
|
|
|
|
say $params->{oauth_version}; |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
If you pass token as third argument, the result includes oauth_token value. |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
my $params = $consumer->gen_auth_params($http_method, $request_url, $token); |
999
|
|
|
|
|
|
|
say $params->{oauth_consumer_key}; |
1000
|
|
|
|
|
|
|
say $params->{oauth_timestamp}; |
1001
|
|
|
|
|
|
|
say $params->{oauth_nonce}; |
1002
|
|
|
|
|
|
|
say $params->{oauth_signature_method}; |
1003
|
|
|
|
|
|
|
say $params->{oauth_signature}; |
1004
|
|
|
|
|
|
|
say $params->{oauth_token}; |
1005
|
|
|
|
|
|
|
say $params->{oauth_version}; |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
=cut |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
sub gen_auth_params { |
1010
|
10
|
|
|
10
|
1
|
4622
|
my ($self, $method, $url, $token, $extra) = @_; |
1011
|
10
|
|
|
|
|
24
|
my $params = {}; |
1012
|
10
|
|
100
|
|
|
46
|
$extra ||= {}; |
1013
|
10
|
|
100
|
|
|
55
|
$params->{oauth_consumer_key} = $self->consumer_key || ''; |
1014
|
10
|
|
33
|
|
|
167
|
$params->{oauth_timestamp} = $self->{_timestamp} || time(); |
1015
|
10
|
|
33
|
|
|
82
|
$params->{oauth_nonce} = $self->{_nonce} || gen_random_key(); |
1016
|
10
|
|
|
|
|
36
|
$params->{oauth_version} = $OAuth::Lite::OAUTH_DEFAULT_VERSION; |
1017
|
10
|
|
|
|
|
15
|
my $token_secret = ''; |
1018
|
10
|
100
|
|
|
|
35
|
if (defined $token) { |
1019
|
4
|
100
|
|
|
|
9
|
if (eval { $token->isa('OAuth::Lite::Token') }) { |
|
4
|
|
|
|
|
40
|
|
1020
|
3
|
|
|
|
|
13
|
$params->{oauth_token} = $token->token; |
1021
|
3
|
|
|
|
|
188
|
$token_secret = $token->secret; |
1022
|
|
|
|
|
|
|
} else { |
1023
|
1
|
|
|
|
|
5
|
$params->{oauth_token} = $token; |
1024
|
|
|
|
|
|
|
} |
1025
|
|
|
|
|
|
|
} |
1026
|
10
|
|
100
|
|
|
66
|
my $consumer_secret = $self->consumer_secret || ''; |
1027
|
10
|
|
|
|
|
119
|
$params->{oauth_signature_method} = $self->{signature_method}->method_name; |
1028
|
10
|
50
|
33
|
|
|
132
|
if ($params->{oauth_signature_method} eq 'PLAINTEXT' && lc($url) !~ /^https/) { |
1029
|
0
|
|
|
|
|
0
|
warn qq(PLAINTEXT signature method should be used on SSL/TSL.); |
1030
|
|
|
|
|
|
|
} |
1031
|
10
|
|
|
|
|
672
|
$params = {%$params, %$extra}; |
1032
|
10
|
|
|
|
|
68
|
my $base = create_signature_base_string($method, $url, $params); |
1033
|
10
|
|
|
|
|
112
|
$params->{oauth_signature} = $self->{signature_method}->new( |
1034
|
|
|
|
|
|
|
consumer_secret => $consumer_secret, |
1035
|
|
|
|
|
|
|
token_secret => $token_secret, |
1036
|
|
|
|
|
|
|
)->sign($base); |
1037
|
10
|
|
|
|
|
89
|
$params; |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
=head2 oauth_request |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=head2 oauth_req |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
Returns last oauth request. |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
my $req_token = $consumer->get_request_token(...); |
1047
|
|
|
|
|
|
|
say $consumer->oauth_request->uri; |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
my $req_token = $consumer->get_access_token(...); |
1050
|
|
|
|
|
|
|
say $consumer->oauth_request->uri; |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
=head2 oauth_response |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=head2 oauth_res |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
Returns last oauth response. |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
my $req_token = $consumer->get_request_token(...); |
1059
|
|
|
|
|
|
|
say $consumer->oauth_response->status; |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
my $req_token = $consumer->get_access_token(...); |
1062
|
|
|
|
|
|
|
say $consumer->oauth_response->status; |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
=head2 oauth_clear |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
remove last oauth-request and oauth-response. |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
=cut |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
sub oauth_clear { |
1071
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
1072
|
0
|
|
|
|
|
0
|
$self->{oauth_request} = undef; |
1073
|
0
|
|
|
|
|
0
|
$self->{oauth_response} = undef; |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
=head2 build_body_hash |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
Build body hash according to the spec for 'OAuth Request Body Hash extension' |
1079
|
|
|
|
|
|
|
http://oauth.googlecode.com/svn/spec/ext/body_hash/1.0/drafts/4/spec.html |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
my $hash = $self->build_body_hash($content); |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
=cut |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
sub build_body_hash { |
1086
|
1
|
|
|
1
|
1
|
2
|
my ( $self, $content ) = @_; |
1087
|
1
|
50
|
|
|
|
5
|
if ( $self->{use_request_body_hash} ) { |
1088
|
0
|
|
|
|
|
0
|
my $hash = $self->{signature_method}->build_body_hash($content); |
1089
|
0
|
|
|
|
|
0
|
return $hash; |
1090
|
|
|
|
|
|
|
} |
1091
|
1
|
|
|
|
|
12
|
return; |
1092
|
|
|
|
|
|
|
} |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
=head1 AUTHOR |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
Lyo Kato, C |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
1101
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.8.6 or, |
1102
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
=cut |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
1; |