File Coverage

blib/lib/Google/API/OAuth2/Client.pm
Criterion Covered Total %
statement 67 98 68.3
branch 16 38 42.1
condition 2 2 100.0
subroutine 12 14 85.7
pod 9 9 100.0
total 106 161 65.8


line stmt bran cond sub pod time code
1             package Google::API::OAuth2::Client;
2              
3 2     2   90916 use strict;
  2         3  
  2         62  
4 2     2   7 use warnings;
  2         3  
  2         49  
5 2     2   967 use URI;
  2         8704  
  2         1627  
6              
7             sub new {
8 8     8 1 9559 my $class = shift;
9 8         11 my ($param) = @_;
10 8         18 for my $key (qw/auth_uri token_uri client_id client_secret/) {
11 29 100       63 return unless $param->{$key};
12             }
13 7 50       24 unless (defined $param->{ua}) {
14 7         59 $param->{ua} = $class->_new_ua;
15             }
16 7 50       26 unless (defined $param->{json_parser}) {
17 7         24 $param->{json_parser} = $class->_new_json_parser;
18             }
19 7         56 bless { %$param }, $class;
20             }
21              
22             sub new_from_client_secrets {
23 2     2 1 7474 my $class = shift;
24 2         5 my ($file, $auth_doc) = @_;
25 2 50       72 open my $fh, '<', $file
26             or die "$file not found";
27 2         3 my $content = do { local $/; <$fh> };
  2         8  
  2         35  
28 2         13 close $fh;
29 2         15 require JSON;
30 2         49 my $json = JSON->new->decode($content);
31 2         19 my ($client_type) = keys(%$json);
32 2         19 $class->new({
33             auth_uri => $json->{$client_type}->{auth_uri},
34             token_uri => $json->{$client_type}->{token_uri},
35             client_id => $json->{$client_type}->{client_id},
36             client_secret => $json->{$client_type}->{client_secret},
37 2         13 redirect_uri => @{$json->{$client_type}->{redirect_uris}}[0],
38             auth_doc => $auth_doc,
39             });
40             }
41              
42             sub authorize_uri {
43 7     7 1 3219 my $self = shift;
44 7         10 my ($response_type) = @_;
45 7   100     34 $response_type ||= 'code';
46 7         13 for my $key (qw/client_id redirect_uri/) {
47 14 50       41 return unless $self->{$key};
48             }
49 7         29 my $authorize_uri = "$self->{auth_uri}?client_id=$self->{client_id}&redirect_uri=$self->{redirect_uri}&response_type=$response_type";
50 7 100       16 if ($self->{auth_doc}) {
51 3         4 my @scopes = keys %{$self->{auth_doc}{oauth2}{scopes}};
  3         10  
52 3         10 $authorize_uri .= '&scope=' . join ' ', @scopes;
53             }
54 7 100       15 if ($self->{access_type}){
55 1         4 $authorize_uri .= "&access_type=$self->{access_type}";
56             }
57 7 50       13 if ($self->{approval_prompt}){
58 0         0 $authorize_uri .= "&approval_prompt=$self->{approval_prompt}";
59             }
60 7         28 return URI->new($authorize_uri)->as_string;
61             }
62              
63             sub exchange {
64 0     0 1 0 my $self = shift;
65 0         0 my ($code) = @_;
66 0 0       0 return unless $code;
67 0 0       0 return unless $self->{auth_doc};
68 0         0 for my $key (qw/client_id client_secret/) {
69 0 0       0 return unless $self->{$key};
70             }
71 0         0 my @scopes = keys %{$self->{auth_doc}{oauth2}{scopes}};
  0         0  
72 0         0 my $scopes = join ' ', @scopes;
73 0         0 my @param = (
74             client_id => $self->{client_id},
75             client_secret => $self->{client_secret},
76             redirect_uri => $self->{redirect_uri},
77             code => $code,
78             scope => $scopes,
79             grant_type => 'authorization_code',
80             );
81 0         0 require HTTP::Request::Common;
82 0         0 my $res = $self->{ua}->request(
83             HTTP::Request::Common::POST(
84             $self->{token_uri},
85             Content_Type => 'application/x-www-form-urlencoded',
86             Content => [@param]
87             )
88             );
89 0 0       0 unless ($res->is_success) {
90 0         0 return;
91             }
92 0         0 my $access_token = $self->{json_parser}->decode($res->content);
93 0         0 $self->{token_obj} = $access_token;
94 0         0 return $self->{token_obj};
95             }
96              
97             sub refresh {
98 0     0 1 0 my $self = shift;
99 0         0 for my $key (qw/client_id client_secret token_obj/) {
100 0 0       0 return unless $self->{$key};
101             }
102 0         0 my @param = (
103             client_id => $self->{client_id},
104             client_secret => $self->{client_secret},
105             refresh_token => $self->{token_obj}{refresh_token},
106             grant_type => 'refresh_token',
107             );
108 0         0 require HTTP::Request::Common;
109 0         0 my $res = $self->{ua}->request(
110             HTTP::Request::Common::POST(
111             $self->{token_uri},
112             Content_Type => 'application/x-www-form-urlencoded',
113             Content => [@param]
114             )
115             );
116 0 0       0 unless ($res->is_success) {
117 0         0 return;
118             }
119 0         0 my $access_token = $self->{json_parser}->decode($res->content);
120 0 0       0 unless ($access_token->{refresh_token}) {
121 0         0 $access_token->{refresh_token} = $self->{token_obj}{refresh_token};
122             }
123 0         0 $self->{token_obj} = $access_token;
124 0         0 return $self->{token_obj};
125             }
126              
127             sub token_obj {
128 1     1 1 861 my $self = shift;
129 1         1 my ($token_obj) = @_;
130 1 50       5 return $self->{token_obj} unless $token_obj;
131 1         2 $self->{token_obj} = $token_obj;
132             }
133              
134             sub token_type {
135 1     1 1 2 my $self = shift;
136 1 50       5 return unless $self->{token_obj};
137 1         4 return $self->{token_obj}{token_type};
138             }
139              
140             sub access_token {
141 1     1 1 5 my $self = shift;
142 1 50       3 return unless $self->{token_obj};
143 1         4 return $self->{token_obj}{access_token};
144             }
145              
146             sub auth_doc {
147 2     2 1 21 my $self = shift;
148 2 100       4 if (@_) {
149 1         2 my ($doc) = @_;
150 1         2 $self->{auth_doc} = $doc;
151             }
152 2         21 return $self->{auth_doc};
153             }
154              
155             sub _new_ua {
156 7     7   9 my $class = shift;
157 7         1261 require LWP::UserAgent;
158 7         53906 my $ua = LWP::UserAgent->new;
159 7         4944 return $ua;
160             }
161              
162             sub _new_json_parser {
163 7     7   8 my $class = shift;
164 7         33 require JSON;
165 7         43 my $parser = JSON->new;
166 7         18 return $parser;
167             }
168              
169             1;
170             __END__