File Coverage

blib/lib/OAuth/Lite2/Server/GrantHandler/ClientCredentials.pm
Criterion Covered Total %
statement 31 31 100.0
branch 7 12 58.3
condition 2 6 33.3
subroutine 6 6 100.0
pod 1 1 100.0
total 47 56 83.9


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