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   238063 use strict;
  2         18  
  2         65  
4 2     2   11 use warnings;
  2         3  
  2         62  
5 2     2   1074 use URI;
  2         12146  
  2         2423  
6              
7             sub new {
8 8     8 1 11388 my $class = shift;
9 8         22 my ($param) = @_;
10 8         21 for my $key (qw/auth_uri token_uri client_id client_secret/) {
11 29 100       78 return unless $param->{$key};
12             }
13 7 50       26 unless (defined $param->{ua}) {
14 7         27 $param->{ua} = $class->_new_ua;
15             }
16 7 50       30 unless (defined $param->{json_parser}) {
17 7         35 $param->{json_parser} = $class->_new_json_parser;
18             }
19 7         148 bless { %$param }, $class;
20             }
21              
22             sub new_from_client_secrets {
23 2     2 1 9733 my $class = shift;
24 2         8 my ($file, $auth_doc) = @_;
25 2 50       139 open my $fh, '<', $file
26             or die "$file not found";
27 2         52 my $content = do { local $/; <$fh> };
  2         14  
  2         77  
28 2         25 close $fh;
29 2         838 require JSON;
30 2         9104 my $json = JSON->new->decode($content);
31 2         19 my ($client_type) = keys(%$json);
32             $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         12 redirect_uri => @{$json->{$client_type}->{redirect_uris}}[0],
  2         33  
38             auth_doc => $auth_doc,
39             });
40             }
41              
42             sub authorize_uri {
43 7     7 1 3443 my $self = shift;
44 7         17 my ($response_type) = @_;
45 7   100     43 $response_type ||= 'code';
46 7         16 for my $key (qw/client_id redirect_uri/) {
47 14 50       46 return unless $self->{$key};
48             }
49 7         32 my $authorize_uri = "$self->{auth_uri}?client_id=$self->{client_id}&redirect_uri=$self->{redirect_uri}&response_type=$response_type";
50 7 100       23 if ($self->{auth_doc}) {
51 3         7 my @scopes = keys %{$self->{auth_doc}{oauth2}{scopes}};
  3         14  
52 3         13 $authorize_uri .= '&scope=' . join ' ', @scopes;
53             }
54 7 100       37 if ($self->{access_type}){
55 1         13 $authorize_uri .= "&access_type=$self->{access_type}";
56             }
57 7 50       20 if ($self->{approval_prompt}){
58 0         0 $authorize_uri .= "&approval_prompt=$self->{approval_prompt}";
59             }
60 7         41 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             my @param = (
74             client_id => $self->{client_id},
75             client_secret => $self->{client_secret},
76             redirect_uri => $self->{redirect_uri},
77 0         0 code => $code,
78             scope => $scopes,
79             grant_type => 'authorization_code',
80             );
81 0         0 require HTTP::Request::Common;
82             my $res = $self->{ua}->request(
83             HTTP::Request::Common::POST(
84             $self->{token_uri},
85 0         0 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             my @param = (
103             client_id => $self->{client_id},
104             client_secret => $self->{client_secret},
105             refresh_token => $self->{token_obj}{refresh_token},
106 0         0 grant_type => 'refresh_token',
107             );
108 0         0 require HTTP::Request::Common;
109             my $res = $self->{ua}->request(
110             HTTP::Request::Common::POST(
111             $self->{token_uri},
112 0         0 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 829 my $self = shift;
129 1         4 my ($token_obj) = @_;
130 1 50       4 return $self->{token_obj} unless $token_obj;
131 1         4 $self->{token_obj} = $token_obj;
132             }
133              
134             sub token_type {
135 1     1 1 4 my $self = shift;
136 1 50       5 return unless $self->{token_obj};
137 1         6 return $self->{token_obj}{token_type};
138             }
139              
140             sub access_token {
141 1     1 1 6 my $self = shift;
142 1 50       4 return unless $self->{token_obj};
143 1         6 return $self->{token_obj}{access_token};
144             }
145              
146             sub auth_doc {
147 2     2 1 14 my $self = shift;
148 2 100       6 if (@_) {
149 1         4 my ($doc) = @_;
150 1         3 $self->{auth_doc} = $doc;
151             }
152 2         5 return $self->{auth_doc};
153             }
154              
155             sub _new_ua {
156 7     7   13 my $class = shift;
157 7         1479 require LWP::UserAgent;
158 7         81677 my $ua = LWP::UserAgent->new;
159 7         7637 return $ua;
160             }
161              
162             sub _new_json_parser {
163 7     7   16 my $class = shift;
164 7         680 require JSON;
165 7         8536 my $parser = JSON->new;
166 7         42 return $parser;
167             }
168              
169             1;
170             __END__