File Coverage

blib/lib/OAuth/Lite2/Server/GrantHandler/Password.pm
Criterion Covered Total %
statement 32 32 100.0
branch 11 16 68.7
condition 2 6 33.3
subroutine 6 6 100.0
pod 1 1 100.0
total 52 61 85.2


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