File Coverage

blib/lib/OAuth/Lite2/Client/ClientCredentials.pm
Criterion Covered Total %
statement 40 42 95.2
branch n/a
condition n/a
subroutine 14 14 100.0
pod n/a
total 54 56 96.4


line stmt bran cond sub pod time code
1             package OAuth::Lite2::Client::ClientCredentials;
2              
3 1     1   1243 use strict;
  1         2  
  1         28  
4 1     1   4 use warnings;
  1         2  
  1         25  
5 1     1   4 use base 'Class::ErrorHandler';
  1         2  
  1         863  
6 1     1   226 use bytes ();
  1         2  
  1         17  
7              
8 1     1   5 use Carp ();
  1         2  
  1         18  
9 1     1   5 use Try::Tiny qw/try catch/;
  1         2  
  1         41  
10 1     1   5 use LWP::UserAgent;
  1         2  
  1         33  
11 1     1   5 use MIME::Base64 qw(encode_base64);
  1         2  
  1         60  
12 1     1   6 use HTTP::Request;
  1         3  
  1         21  
13 1     1   5 use HTTP::Headers;
  1         2  
  1         55  
14 1     1   7 use Params::Validate qw(HASHREF);
  1         2  
  1         44  
15 1     1   4 use OAuth::Lite2;
  1         2  
  1         30  
16 1     1   4 use OAuth::Lite2::Util qw(build_content);
  1         1  
  1         50  
17 1     1   448 use OAuth::Lite2::Client::TokenResponseParser;
  0            
  0            
18              
19             =head1 NAME
20              
21             OAuth::Lite2::Client::ClientCredentials - OAuth 2.0 ClientCredentials Profile Client
22              
23             =head1 SYNOPSIS
24              
25             my $client = OAuth::Lite2::Client::WebServer->new(
26             id => q{my_client_id},
27             secret => q{my_client_secret},
28             access_token_uri => q{http://example.org/token},
29             );
30              
31             sub get_access_token {
32             my $your_app = shift;
33              
34             my $access_token = $client->get_access_token(
35             scope => q{photo},
36             ) or return $your_app->error( $client->errstr );
37              
38             $your_app->store->save( access_token => $access_token->access_token );
39             $your_app->store->save( expires_at => time() + $access_token->expires_in );
40             $your_app->store->save( refresh_token => $access_token->refresh_token );
41             }
42              
43             sub refresh_access_token {
44             my $your_app = shift;
45              
46             my $access_token = $client->refresh_access_token(
47             refresh_token => $refresh_token,
48             ) or return $your_app->error( $client->errstr );
49              
50             $your_app->store->save( access_token => $access_token->access_token );
51             $your_app->store->save( expires_at => time() + $access_token->expires_in );
52             $your_app->store->save( refresh_token => $access_token->refresh_token );
53             }
54              
55             sub access_to_protected_resource {
56             my $your_app = shift;
57              
58             my $access_token = $your_app->store->get("access_token");
59             my $expires_at = $your_app->store->get("expires_at");
60             my $refresh_token = $your_app->store->get("refresh_token");
61              
62             unless ($access_token) {
63             $your_app->show_reauthorize_page();
64             return;
65             }
66              
67             if ($expires_at < time()) {
68             $your_app->refresh_access_token();
69             return;
70             }
71              
72             my $req = HTTP::Request->new( GET => q{http://example.org/photo} );
73             $req->header( Authorization => sprintf(q{OAuth %s}, $access_token) );
74             my $agent = LWP::UserAgent->new;
75             my $res = $agent->request($req);
76             ...
77             }
78              
79              
80             =head1 DESCRIPTION
81              
82             OAuth 2.0 ClientCredentials Profile Client.
83              
84              
85             =head2 new( %params )
86              
87             =over 4
88              
89             =item id
90              
91             Client ID
92              
93             =item secret
94              
95             Client secret
96              
97             =item access_token_uri
98              
99             token endpoint uri on auth-server.
100              
101             =item refresh_token_uri
102              
103             refresh-token endpoint uri on auth-server.
104             if you omit this, access_token_uri is used instead.
105              
106             =item agent
107              
108             user agent. if you omit this, LWP::UserAgent's object is set by default.
109             You can use your custom agent or preset-agents.
110              
111             See also
112              
113             L
114             L
115             L
116              
117             =back
118              
119             =cut
120              
121             sub new {
122             my $class = shift;
123              
124             my %args = Params::Validate::validate(@_, {
125             id => 1,
126             secret => 1,
127             # format => { optional => 1 },
128             access_token_uri => { optional => 1 },
129             refresh_token_uri => { optional => 1 },
130             agent => { optional => 1 },
131             });
132              
133             my $self = bless {
134             id => undef,
135             secret => undef,
136             access_token_uri => undef,
137             refresh_token_uri => undef,
138             last_request => undef,
139             last_response => undef,
140             %args,
141             }, $class;
142              
143             unless ($self->{agent}) {
144             $self->{agent} = LWP::UserAgent->new;
145             $self->{agent}->agent(
146             join "/", __PACKAGE__, $OAuth::Lite2::VERSION);
147             }
148              
149             # $self->{format} ||= 'json';
150             $self->{response_parser} = OAuth::Lite2::Client::TokenResponseParser->new;
151              
152             return $self;
153             }
154              
155             =head2 get_access_token( %params )
156              
157             =over 4
158              
159             =item scope
160              
161             =back
162              
163             =cut
164              
165             sub get_access_token {
166             my $self = shift;
167              
168             my %args = Params::Validate::validate(@_, {
169             scope => { optional => 1 },
170             uri => { optional => 1 },
171             use_basic_schema => { optional => 1 },
172             # secret_type => { optional => 1 },
173             # format => { optional => 1 },
174             });
175              
176             unless (exists $args{uri}) {
177             $args{uri} = $self->{access_token_uri}
178             || Carp::croak "uri not found";
179             }
180              
181             # $args{format} ||= $self->{format};
182              
183             my %params = (
184             grant_type => 'client_credentials',
185             # format => $args{format},
186             );
187              
188             unless ($args{use_basic_schema}){
189             $params{client_id} = $self->{id};
190             $params{client_secret} = $self->{secret};
191             }
192              
193             $params{scope} = $args{scope}
194             if $args{scope};
195              
196             # $params{secret_type} = $args{secret_type}
197             # if $args{secret_type};
198              
199             my $content = build_content(\%params);
200             my $headers = HTTP::Headers->new;
201             $headers->header("Content-Type" => q{application/x-www-form-urlencoded});
202             $headers->header("Content-Length" => bytes::length($content));
203             $headers->authorization_basic($self->{id}, $self->{secret})
204             if($args{use_basic_schema});
205             my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content );
206              
207             my $res = $self->{agent}->request($req);
208             $self->{last_request} = $req;
209             $self->{last_response} = $res;
210              
211             my ($token, $errmsg);
212             try {
213             $token = $self->{response_parser}->parse($res);
214             } catch {
215             $errmsg = "$_";
216             };
217             return $token || $self->error($errmsg);
218              
219             }
220              
221             =head2 refresh_access_token( %params )
222              
223             =over 4
224              
225             =item refresh_token
226              
227             =back
228              
229             =cut
230              
231             sub refresh_access_token {
232             my $self = shift;
233              
234             my %args = Params::Validate::validate(@_, {
235             refresh_token => 1,
236             uri => { optional => 1 },
237             use_basic_schema => { optional => 1 },
238             # secret_type => { optional => 1 },
239             # format => { optional => 1 },
240             });
241              
242             unless (exists $args{uri}) {
243             $args{uri} = $self->{access_token_uri}
244             || Carp::croak "uri not found";
245             }
246              
247             # $args{format} ||= $self->{format};
248              
249             my %params = (
250             grant_type => 'refresh_token',
251             refresh_token => $args{refresh_token},
252             # format => $args{format},
253             );
254              
255             unless ($args{use_basic_schema}){
256             $params{client_id} = $self->{id};
257             $params{client_secret} = $self->{secret};
258             }
259              
260             # $params{secret_type} = $args{secret_type}
261             # if $args{secret_type};
262              
263             my $content = build_content(\%params);
264             my $headers = HTTP::Headers->new;
265             $headers->header("Content-Type" => q{application/x-www-form-urlencoded});
266             $headers->header("Content-Length" => bytes::length($content));
267             $headers->authorization_basic($self->{id}, $self->{secret})
268             if($args{use_basic_schema});
269             my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content );
270              
271             my $res = $self->{agent}->request($req);
272             $self->{last_request} = $req;
273             $self->{last_response} = $res;
274              
275             my ($token, $errmsg);
276             try {
277             $token = $self->{response_parser}->parse($res);
278             } catch {
279             $errmsg = "$_";
280             };
281             return $token || $self->error($errmsg);
282             }
283              
284             =head2 get_grouping_refresh_token( %params )
285              
286             =over 4
287              
288             =item client_id
289              
290             =item client_secret
291              
292             =item refresh_token
293              
294             =item scope
295              
296             =back
297              
298             =cut
299              
300             sub get_grouping_refresh_token {
301             my $self = shift;
302              
303             my %args = Params::Validate::validate(@_, {
304             refresh_token => 1,
305             scope => { optional => 1 },
306             uri => { optional => 1 },
307             use_basic_schema => { optional => 1 },
308             });
309              
310             unless (exists $args{uri}) {
311             $args{uri} = $self->{access_token_uri}
312             || Carp::croak "uri not found";
313             }
314              
315             my %params = (
316             grant_type => 'grouping_refresh_token',
317             refresh_token => $args{refresh_token},
318             );
319             $params{scope} = $args{scope}
320             if $args{scope};
321              
322             unless ($args{use_basic_schema}){
323             $params{client_id} = $self->{id};
324             $params{client_secret} = $self->{secret};
325             }
326              
327             my $content = build_content(\%params);
328             my $headers = HTTP::Headers->new;
329             $headers->header("Content-Type" => q{application/x-www-form-urlencoded});
330             $headers->header("Content-Length" => bytes::length($content));
331             $headers->authorization_basic($self->{id}, $self->{secret})
332             if($args{use_basic_schema});
333             my $req = HTTP::Request->new( POST => $args{uri}, $headers, $content );
334              
335             my $res = $self->{agent}->request($req);
336             $self->{last_request} = $req;
337             $self->{last_response} = $res;
338              
339             my ($token, $errmsg);
340             try {
341             $token = $self->{response_parser}->parse($res);
342             } catch {
343             $errmsg = "$_";
344             };
345             return $token || $self->error($errmsg);
346             }
347              
348             =head2 last_request
349              
350             Returns a HTTP::Request object that is used
351             when you obtain or refresh access token last time internally.
352              
353             =head2 last_request
354              
355             Returns a HTTP::Response object that is used
356             when you obtain or refresh access token last time internally.
357              
358             =cut
359              
360             sub last_request { $_[0]->{last_request} }
361             sub last_response { $_[0]->{last_response} }
362              
363             =head1 AUTHOR
364              
365             Lyo Kato, Elyo.kato@gmail.comE
366              
367             =head1 COPYRIGHT AND LICENSE
368              
369             Copyright (C) 2010 by Lyo Kato
370              
371             This library is free software; you can redistribute it and/or modify
372             it under the same terms as Perl itself, either Perl version 5.8.8 or,
373             at your option, any later version of Perl 5 you may have available.
374              
375             =cut
376              
377             1;