File Coverage

blib/lib/OAuth/Lite2/Server/GrantHandler/Password.pm
Criterion Covered Total %
statement 37 37 100.0
branch 12 18 66.6
condition 2 6 33.3
subroutine 7 7 100.0
pod 1 1 100.0
total 59 69 85.5


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