File Coverage

blib/lib/OAuth/Lite2/Server/GrantHandler/AuthorizationCode.pm
Criterion Covered Total %
statement 31 31 100.0
branch 15 20 75.0
condition 4 9 44.4
subroutine 6 6 100.0
pod 1 1 100.0
total 57 67 85.0


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