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   2119 use strict;
  2         3  
  2         58  
4 2     2   9 use warnings;
  2         4  
  2         45  
5              
6 2     2   10 use parent 'OAuth::Lite2::Server::GrantHandler';
  2         2  
  2         13  
7 2     2   85 use OAuth::Lite2::Server::Error;
  2         4  
  2         50  
8 2     2   490 use OAuth::Lite2::ParamMethod::AuthHeader;
  2         5  
  2         42  
9 2     2   9 use Carp ();
  2         3  
  2         503  
10              
11             sub handle_request {
12 3     3 1 121 my ($self, $dh) = @_;
13              
14 3         16 my $req = $dh->request;
15              
16 3         19 my $parser = OAuth::Lite2::ParamMethod::AuthHeader->new;
17 3         14 my $header_credentials = $parser->basic_credentials($req);
18 3 50       14 my $client_id = ($header_credentials->{client_id}) ? $header_credentials->{client_id} : $req->param("client_id");
19 3 50       658 my $client_secret = ($header_credentials->{client_secret}) ? $header_credentials->{client_secret} : $req->param("client_secret");
20              
21 3         39 my $user_id = $dh->get_client_user_id($client_id, $client_secret);
22 3 100       37 OAuth::Lite2::Server::Error::InvalidClient->throw unless defined $user_id;
23              
24 2         6 my $scope = $req->param("scope");
25              
26 2         23 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     39 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         9 my $access_token = $dh->create_or_update_access_token(
36             auth_info => $auth_info,
37             );
38 2 50 33     31 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         8 my $res = {
43             token_type => 'Bearer',
44             access_token => $access_token->token,
45             };
46 2 50       15 $res->{expires_in} = $access_token->expires_in
47             if $access_token->expires_in;
48 2 50       24 $res->{refresh_token} = $auth_info->refresh_token
49             if $auth_info->refresh_token;
50 2 50       22 $res->{scope} = $auth_info->scope
51             if $auth_info->scope;
52              
53 2         25 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;