File Coverage

blib/lib/OAuth/Lite/Consumer.pm
Criterion Covered Total %
statement 176 282 62.4
branch 40 92 43.4
condition 32 106 30.1
subroutine 29 41 70.7
pod 21 21 100.0
total 298 542 54.9


line stmt bran cond sub pod time code
1             package OAuth::Lite::Consumer;
2              
3 4     4   6053 use strict;
  4         8  
  4         174  
4 4     4   19 use warnings;
  4         5  
  4         141  
5              
6 4         2396 use base qw(
7             Class::ErrorHandler
8             Class::Accessor::Fast
9 4     4   19 );
  4         7  
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   10203 use Carp ();
  4         8  
  4         56  
24 4     4   2559 use bytes ();
  4         35  
  4         88  
25 4     4   1576 use URI;
  4         15475  
  4         108  
26 4     4   1941 use HTTP::Request;
  4         65633  
  4         172  
27 4     4   36 use HTTP::Headers;
  4         6  
  4         115  
28 4     4   2465 use UNIVERSAL::require;
  4         5513  
  4         42  
29 4     4   1870 use List::MoreUtils qw(any);
  4         35074  
  4         41  
30              
31 4     4   3893 use OAuth::Lite;
  4         9  
  4         34  
32 4     4   1894 use OAuth::Lite::Agent;
  4         15  
  4         58  
33 4     4   1865 use OAuth::Lite::Token;
  4         15  
  4         40  
34 4     4   2119 use OAuth::Lite::Response;
  4         10  
  4         56  
35 4     4   170 use OAuth::Lite::Util qw(:all);
  4         7  
  4         724  
36 4     4   1274 use OAuth::Lite::AuthMethod qw(:all);
  4         10  
  4         14050  
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 1504 my ($class, %args) = @_;
271 8         22 my $ua = delete $args{ua};
272 8 50       31 unless ($ua) {
273 8         64 $ua = OAuth::Lite::Agent->new;
274 8         51 $ua->agent(join "/", __PACKAGE__, $OAuth::Lite::VERSION);
275             }
276 8         416 my $self = bless {
277             ua => $ua,
278             }, $class;
279 8         41 $self->_init(%args);
280 8         38 $self;
281             }
282              
283             sub _init {
284 8     8   24 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         20 $signature_method_class =~ s/-/_/g;
290 8         22 $signature_method_class = join('::',
291             'OAuth::Lite::SignatureMethod',
292             $signature_method_class
293             );
294 8 50       56 $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     272 $self->{consumer_key} = $args{consumer_key} || '';
302 8   100     34 $self->{consumer_secret} = $args{consumer_secret} || '';
303 8   100     43 $self->{http_method} = $args{http_method} || 'POST';
304 8   100     42 $self->{auth_method} = $args{auth_method} || AUTH_HEADER;
305 8 50       53 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         32 $self->{signature_method} = $signature_method_class;
310 8         15 $self->{realm} = $args{realm};
311 8         23 $self->{site} = $args{site};
312 8         15 $self->{request_token_path} = $args{request_token_path};
313 8         17 $self->{access_token_path} = $args{access_token_path};
314 8         26 $self->{authorize_path} = $args{authorize_path};
315 8         17 $self->{callback_url} = $args{callback_url};
316 8         13 $self->{oauth_request} = undef;
317 8         13 $self->{oauth_response} = undef;
318 8 50       28 $self->{use_request_body_hash} = $args{use_request_body_hash} ? 1 : 0;
319 8         22 $self->{_nonce} = $args{_nonce};
320 8         27 $self->{_timestamp} = $args{_timestamp};
321             }
322              
323             =head2 request_token_url
324              
325             =cut
326              
327             sub request_token_url {
328 3     3 1 12 my $self = shift;
329 3 100       23 $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 7 my $self = shift;
341 3 100       124 $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 11 my $self = shift;
352 8 100       57 $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 1069 my ($self, %args) = @_;
384 5   33     20 $args{url} ||= $self->authorization_url;
385 5 50       11 my $url = $args{url}
386             or Carp::croak qq/url_to_authorize needs url./;
387 5         7 my %params = ();
388 5 100       12 if (defined $args{token}) {
389 3         5 my $token = $args{token};
390 3 100       6 $params{oauth_token} = ( eval { $token->isa('OAuth::Lite::Token') } )
  3         40  
391             ? $token->token
392             : $token;
393             }
394 5         30 $url = URI->new($url);
395 5         6879 $url->query_form(%params);
396 5         271 $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 856 my ($self, %args) = @_;
636              
637 2   66     13 my $method = $args{method} || $self->{http_method};
638 2         4 my $url = $args{url};
639 2         5 my $content = $args{content};
640 2         4 my $token = $args{token};
641 2   50     6 my $extra = $args{params} || {};
642 2   50     24 my $realm = $args{realm}
643             || $self->{realm}
644             || $self->find_realm_from_last_response
645             || '';
646              
647 2 100       37 if (ref $extra eq 'ARRAY') {
648 1         1 my %hash;
649 1         7 for (0...scalar(@$extra)/2-1) {
650 7         8 my $key = $extra->[$_ * 2];
651 7         6 my $value = $extra->[$_ * 2 + 1];
652 7   100     22 $hash{$key} ||= [];
653 7         4 push @{ $hash{$key} }, $value;
  7         13  
654             }
655 1         3 $extra = \%hash;
656             }
657              
658 2         5 my $headers = $args{headers};
659 2 50       9 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         26 $headers = HTTP::Headers->new;
667             }
668              
669 2         21 my @send_data_methods = qw/POST PUT/;
670 2         7 my @non_send_data_methods = qw/GET HEAD DELETE/;
671              
672 2     3   15 my $is_send_data_method = any { $method eq $_ } @send_data_methods;
  3         9  
673              
674 2         10 my $auth_method = $self->{auth_method};
675 2 50 66     21 $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         3 my $copied_params = {};
698 2         11 for my $param_key ( keys %$extra ) {
699 5 100       27 next if $param_key =~ /^x?oauth_/;
700 4         7 $copied_params->{$param_key} = $extra->{$param_key};
701             }
702 2 100       10 if ( keys %$copied_params > 0 ) {
703 1         5 my $data = normalize_params($copied_params);
704 1 50 33     5 if ( $is_send_data_method && !$content ) {
705 0         0 $content = $data;
706             } else {
707 1         4 $url = sprintf q{%s?%s}, $url, $data;
708             }
709             }
710 2 100       6 if ( $is_send_data_method ) {
711 1 50       5 if ( my $hash = $self->build_body_hash($content) ) {
712 0         0 $extra->{oauth_body_hash} = $hash;
713             }
714             }
715 2         14 my $header = $self->gen_auth_header($method, $origin_url,
716             { realm => $realm, token => $token, extra => $extra });
717 2         23 $headers->header( Authorization => $header );
718             }
719 2 100       136 if ( $is_send_data_method ) {
720 1 50       3 $headers->header('Content-Type', q{application/x-www-form-urlencoded})
721             unless $headers->header('Content-Type');
722 1   50     51 $headers->header('Content-Length', bytes::length($content) || 0 );
723             }
724 2         941 my $req = HTTP::Request->new( $method, $url, $headers, $content );
725 2         575 $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 4 my $self = shift;
933 2 50       11 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     7 my $extra = $args->{extra} || {};
966 2         10 my $params = $self->gen_auth_params($method, $url, $args->{token}, $extra);
967 2   50     15 my $realm = $args->{realm} || '';
968 2         10 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 975 my ($self, $method, $url, $token, $extra) = @_;
978 4   100     15 $extra ||= {};
979 4         8 my $params = $self->gen_auth_params($method, $url, $token, $extra);
980 4         16 my %all = (%$extra, %$params);
981 4         18 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 1704 my ($self, $method, $url, $token, $extra) = @_;
1011 10         16 my $params = {};
1012 10   100     42 $extra ||= {};
1013 10   100     37 $params->{oauth_consumer_key} = $self->consumer_key || '';
1014 10   33     117 $params->{oauth_timestamp} = $self->{_timestamp} || time();
1015 10   33     52 $params->{oauth_nonce} = $self->{_nonce} || gen_random_key();
1016 10         24 $params->{oauth_version} = $OAuth::Lite::OAUTH_DEFAULT_VERSION;
1017 10         13 my $token_secret = '';
1018 10 100       30 if (defined $token) {
1019 4 100       7 if (eval { $token->isa('OAuth::Lite::Token') }) {
  4         28  
1020 3         11 $params->{oauth_token} = $token->token;
1021 3         17 $token_secret = $token->secret;
1022             } else {
1023 1         2 $params->{oauth_token} = $token;
1024             }
1025             }
1026 10   100     39 my $consumer_secret = $self->consumer_secret || '';
1027 10         85 $params->{oauth_signature_method} = $self->{signature_method}->method_name;
1028 10 50 33     103 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         57 $params = {%$params, %$extra};
1032 10         48 my $base = create_signature_base_string($method, $url, $params);
1033 10         89 $params->{oauth_signature} = $self->{signature_method}->new(
1034             consumer_secret => $consumer_secret,
1035             token_secret => $token_secret,
1036             )->sign($base);
1037 10         67 $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       4 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         4 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;