File Coverage

blib/lib/OAuth/Lite2/Server/GrantHandler/ClientCredentials.pm
Criterion Covered Total %
statement 36 36 100.0
branch 9 16 56.2
condition 2 6 33.3
subroutine 7 7 100.0
pod 1 1 100.0
total 55 66 83.3


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