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