File Coverage

blib/lib/OAuth/Lite2/Server/GrantHandler/RefreshToken.pm
Criterion Covered Total %
statement 34 34 100.0
branch 12 18 66.6
condition 2 6 33.3
subroutine 7 7 100.0
pod 1 1 100.0
total 56 66 84.8


line stmt bran cond sub pod time code
1             package OAuth::Lite2::Server::GrantHandler::RefreshToken;
2              
3 2     2   2046 use strict;
  2         6  
  2         55  
4 2     2   10 use warnings;
  2         3  
  2         47  
5              
6 2     2   9 use parent 'OAuth::Lite2::Server::GrantHandler';
  2         3  
  2         14  
7 2     2   92 use OAuth::Lite2::Server::Error;
  2         4  
  2         36  
8 2     2   556 use OAuth::Lite2::ParamMethod::AuthHeader;
  2         5  
  2         44  
9 2     2   10 use Carp ();
  2         3  
  2         521  
10              
11             sub handle_request {
12 4     4 1 133 my ($self, $dh) = @_;
13              
14 4         19 my $req = $dh->request;
15              
16 4         20 my $parser = OAuth::Lite2::ParamMethod::AuthHeader->new;
17 4         13 my $header_credentials = $parser->basic_credentials($req);
18 4 50       19 my $client_id = ($header_credentials->{client_id}) ? $header_credentials->{client_id} : $req->param("client_id");
19              
20 4 100       857 my $refresh_token = $req->param("refresh_token")
21             or OAuth::Lite2::Server::Error::InvalidRequest->throw(
22             description => "'refresh_token' not found"
23             );
24              
25 3 100       40 my $auth_info = $dh->get_auth_info_by_refresh_token($refresh_token)
26             or OAuth::Lite2::Server::Error::InvalidGrant->throw;
27 2 50 33     44 Carp::croak "OAuth::Lite2::Server::DataHandler::get_auth_info_by_refresh_token doesn't return OAuth::Lite2::Model::AuthInfo"
28             unless ($auth_info
29             && $auth_info->isa("OAuth::Lite2::Model::AuthInfo"));
30              
31 2 100       7 OAuth::Lite2::Server::Error::InvalidClient->throw
32             unless $auth_info->client_id eq $client_id;
33              
34 1         11 my $access_token = $dh->create_or_update_access_token(
35             auth_info => $auth_info,
36             );
37 1 50 33     21 Carp::croak "OAuth::Lite2::Server::DataHandler::create_or_update_access_token doesn't return OAuth::Lite2::Model::AccessToken"
38             unless ($access_token
39             && $access_token->isa("OAuth::Lite2::Model::AccessToken"));
40              
41 1         5 my $res = {
42             token_type => 'Bearer',
43             access_token => $access_token->token,
44             };
45 1 50       8 $res->{expires_in} = $access_token->expires_in
46             if $access_token->expires_in;
47 1 50       12 $res->{refresh_token} = $auth_info->refresh_token
48             if $auth_info->refresh_token;
49 1 50       12 $res->{scope} = $auth_info->scope
50             if $auth_info->scope;
51              
52 1         12 return $res;
53             }
54              
55             =head1 NAME
56              
57             OAuth::Lite2::Server::GrantHandler::RefreshToken - handler for 'refresh-token' grant_type request
58              
59             =head1 SYNOPSIS
60              
61             my $handler = OAuth::Lite2::Server::GrantHandler::RefreshToken->new;
62             my $res = $handler->handle_request( $data_handler );
63              
64             =head1 DESCRIPTION
65              
66             handler for 'refresh-token' grant_type request.
67              
68             =head1 METHODS
69              
70             =head2 handle_request( $req )
71              
72             See L document.
73              
74             =head1 AUTHOR
75              
76             Lyo Kato, Elyo.kato@gmail.comE
77              
78             =head1 COPYRIGHT AND LICENSE
79              
80             Copyright (C) 2010 by Lyo Kato
81              
82             This library is free software; you can redistribute it and/or modify
83             it under the same terms as Perl itself, either Perl version 5.8.8 or,
84             at your option, any later version of Perl 5 you may have available.
85              
86             =cut
87              
88             1;