| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Net::Google::OAuth; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | our $VERSION = '0.02'; | 
| 4 |  |  |  |  |  |  |  | 
| 5 | 1 |  |  | 1 |  | 2359 | use 5.008001; | 
|  | 1 |  |  |  |  | 4 |  | 
| 6 | 1 |  |  | 1 |  | 5 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 29 |  | 
| 7 | 1 |  |  | 1 |  | 12 | use warnings; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 32 |  | 
| 8 | 1 |  |  | 1 |  | 5 | use utf8; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 4 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 | 1 |  |  | 1 |  | 704 | use LWP::UserAgent; | 
|  | 1 |  |  |  |  | 50765 |  | 
|  | 1 |  |  |  |  | 36 |  | 
| 11 | 1 |  |  | 1 |  | 8 | use HTTP::Request; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 27 |  | 
| 12 | 1 |  |  | 1 |  | 5 | use URI; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 22 |  | 
| 13 | 1 |  |  | 1 |  | 732 | use JSON::XS; | 
|  | 1 |  |  |  |  | 4948 |  | 
|  | 1 |  |  |  |  | 64 |  | 
| 14 | 1 |  |  | 1 |  | 7 | use Carp qw/carp croak/; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 1124 |  | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | sub new { | 
| 17 | 0 |  |  | 0 | 1 |  | my ($class, %opt) = @_; | 
| 18 | 0 |  |  |  |  |  | my $self = {}; | 
| 19 | 0 |  | 0 |  |  |  | $self->{client_secret}          = $opt{-client_secret}      || croak "You must specify '-client_secret' param"; | 
| 20 | 0 |  | 0 |  |  |  | $self->{client_id}              = $opt{-client_id}          || croak "You must specify '-client_id' param"; | 
| 21 | 0 |  |  |  |  |  | $self->{token}                  = {}; | 
| 22 | 0 |  |  |  |  |  | $self->{ua}                     = LWP::UserAgent->new(); | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | # Get list of OpenId services | 
| 25 | 0 |  |  |  |  |  | __getOpenIdServices($self); | 
| 26 |  |  |  |  |  |  |  | 
| 27 | 0 |  |  |  |  |  | return bless $self, $class; | 
| 28 |  |  |  |  |  |  | } | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | sub generateAccessToken { | 
| 32 | 0 |  |  | 0 | 1 |  | my ($self, %opt)            = @_; | 
| 33 | 0 |  | 0 |  |  |  | $self->{scope}              = $opt{-scope}              || croak "You must specify '-scope' param"; | 
| 34 | 0 |  | 0 |  |  |  | $self->{email}              = $opt{-email}              || croak "You must specify '-email' param"; | 
| 35 | 0 |  |  |  |  |  | $self->{scope}              = 'https://www.googleapis.com/auth/' . $self->{scope}; | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | my $param = { | 
| 39 |  |  |  |  |  |  | 'client_id'         => $self->{client_id}, | 
| 40 |  |  |  |  |  |  | 'response_type'     => 'code', | 
| 41 |  |  |  |  |  |  | 'scope'             => $self->{scope}, | 
| 42 |  |  |  |  |  |  | 'redirect_uri'      => 'http://localhost:8000', | 
| 43 |  |  |  |  |  |  | 'state'             => 'uniq_state_' . int(rand() * 100000), | 
| 44 |  |  |  |  |  |  | 'login_hint'        => $self->{email}, | 
| 45 | 0 |  |  |  |  |  | 'nonce'             => int(rand() * 1000000) . '-' . int(rand() * 1000000) . '-' . int(rand() * 1000000), | 
| 46 |  |  |  |  |  |  | 'access_type'       => 'offline', | 
| 47 |  |  |  |  |  |  | }; | 
| 48 |  |  |  |  |  |  |  | 
| 49 | 0 |  |  |  |  |  | my $uri = URI->new($self->{services}->{authorization_endpoint}); | 
| 50 | 0 |  |  |  |  |  | $uri->query_form($param); | 
| 51 |  |  |  |  |  |  |  | 
| 52 | 0 |  |  |  |  |  | print STDOUT "Please open this URL in your browser: \n", "\x1b[4;34m", $uri->as_string, "\x1b[0m", "\n"; | 
| 53 | 0 |  |  |  |  |  | print STDOUT "Insert redirected address from browser here:\n"; | 
| 54 | 0 |  |  |  |  |  | my $response_step1 = ; | 
| 55 | 0 |  |  |  |  |  | $response_step1 =~ s/\r|\n//g; | 
| 56 |  |  |  |  |  |  |  | 
| 57 | 0 | 0 |  |  |  |  | $uri = URI->new($response_step1) or croak "Can't parse response: $response_step1"; | 
| 58 | 0 |  |  |  |  |  | my %query_form = $uri->query_form(); | 
| 59 | 0 |  | 0 |  |  |  | my $code_step1 = $query_form{code} // croak "Can't get 'code' from response url"; | 
| 60 |  |  |  |  |  |  |  | 
| 61 | 0 |  |  |  |  |  | my $token = $self->__exchangeCodeToToken( | 
| 62 |  |  |  |  |  |  | -code           => $code_step1, | 
| 63 |  |  |  |  |  |  | -grant_type     => 'authorization_code', | 
| 64 |  |  |  |  |  |  | ); | 
| 65 |  |  |  |  |  |  |  | 
| 66 | 0 |  |  |  |  |  | for my $key (keys %$token) { | 
| 67 | 0 |  |  |  |  |  | $self->{token}->{$key} = $token->{$key}; | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  |  | 
| 70 | 0 |  |  |  |  |  | return 1; | 
| 71 |  |  |  |  |  |  | } | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | sub getTokenInfo { | 
| 74 | 0 |  |  | 0 | 1 |  | my ($self, %opt) = @_; | 
| 75 | 0 |  | 0 |  |  |  | my $access_token = $opt{-access_token} || $self->getAccessToken() || croak "You must specify '-access_token'"; | 
| 76 |  |  |  |  |  |  |  | 
| 77 | 0 |  |  |  |  |  | my $request = $self->{ua}->get('https://www.googleapis.com/oauth2/v2/tokeninfo?access_token=' . $access_token); | 
| 78 | 0 |  |  |  |  |  | my $response_code = $request->code; | 
| 79 | 0 | 0 |  |  |  |  | croak "Can't getTokenInfo about token: $access_token. Code: $response_code" if $response_code != 200; | 
| 80 |  |  |  |  |  |  |  | 
| 81 | 0 |  |  |  |  |  | my $response = decode_json($request->content); | 
| 82 |  |  |  |  |  |  |  | 
| 83 | 0 |  |  |  |  |  | return $response; | 
| 84 |  |  |  |  |  |  | } | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | sub refreshToken { | 
| 89 | 0 |  |  | 0 | 1 |  | my ($self, %opt) = @_; | 
| 90 | 0 |  | 0 |  |  |  | my $refresh_token = $opt{-refresh_token}    || croak "You must specify '-refresh_token' param"; | 
| 91 | 0 |  |  |  |  |  | my $token = $self->__exchangeCodeToToken( | 
| 92 |  |  |  |  |  |  | -code           => $refresh_token, | 
| 93 |  |  |  |  |  |  | -grant_type     => 'refresh_token', | 
| 94 |  |  |  |  |  |  | ); | 
| 95 |  |  |  |  |  |  |  | 
| 96 | 0 |  |  |  |  |  | for my $key (keys %$token) { | 
| 97 | 0 |  |  |  |  |  | $self->{token}->{$key} = $token->{$key}; | 
| 98 |  |  |  |  |  |  | } | 
| 99 |  |  |  |  |  |  |  | 
| 100 | 0 |  |  |  |  |  | return 1; | 
| 101 |  |  |  |  |  |  | } | 
| 102 |  |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | sub __exchangeCodeToToken{ | 
| 104 |  |  |  |  |  |  | #Exchange code or refresh token to AccessToken | 
| 105 | 0 |  |  | 0 |  |  | my ($self, %opt)    = @_; | 
| 106 | 0 |  |  |  |  |  | my $code            = $opt{-code}; | 
| 107 | 0 |  | 0 |  |  |  | my $grant_type      = $opt{-grant_type} || croak "You must specify '-grant_type' param"; | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | # Exchange code to token | 
| 110 |  |  |  |  |  |  | my $param = { | 
| 111 |  |  |  |  |  |  | 'client_id'         => $self->{client_id}, | 
| 112 |  |  |  |  |  |  | 'client_secret'     => $self->{client_secret}, | 
| 113 | 0 |  |  |  |  |  | 'redirect_uri'      => 'http://localhost:8000', | 
| 114 |  |  |  |  |  |  | 'grant_type'        => $grant_type, | 
| 115 |  |  |  |  |  |  | 'access_type'       => 'offline', | 
| 116 |  |  |  |  |  |  | }; | 
| 117 | 0 | 0 |  |  |  |  | if ($grant_type eq 'authorization_code') { | 
|  |  | 0 |  |  |  |  |  | 
| 118 | 0 |  |  |  |  |  | $param->{code} = $code; | 
| 119 |  |  |  |  |  |  | } | 
| 120 |  |  |  |  |  |  | elsif ($grant_type eq 'refresh_token') { | 
| 121 | 0 |  |  |  |  |  | $param->{refresh_token} = $code; | 
| 122 |  |  |  |  |  |  | } | 
| 123 |  |  |  |  |  |  | else { | 
| 124 | 0 |  |  |  |  |  | croak "Param '-grant_type' must contain values: 'authorization_code' or 'refresh_token'"; | 
| 125 |  |  |  |  |  |  | } | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | my $response = $self->{ua}->post( | 
| 128 |  |  |  |  |  |  | $self->{services}->{token_endpoint}, | 
| 129 | 0 |  |  |  |  |  | $param, | 
| 130 |  |  |  |  |  |  | ); | 
| 131 | 0 |  |  |  |  |  | my $response_code = $response->code; | 
| 132 | 0 | 0 |  |  |  |  | croak "Can't get token. Code: $response_code" if $response_code != 200; | 
| 133 |  |  |  |  |  |  |  | 
| 134 | 0 |  |  |  |  |  | my $token = decode_json($response->content); | 
| 135 |  |  |  |  |  |  |  | 
| 136 | 0 |  |  |  |  |  | return $token; | 
| 137 |  |  |  |  |  |  | } | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | sub __getOpenIdServices { | 
| 140 | 0 |  |  | 0 |  |  | my ($self) = @_; | 
| 141 |  |  |  |  |  |  |  | 
| 142 | 0 |  |  |  |  |  | my $request = $self->{ua}->get('https://accounts.google.com/.well-known/openid-configuration'); | 
| 143 | 0 |  |  |  |  |  | my $response_code = $request->code; | 
| 144 | 0 | 0 |  |  |  |  | croak "Can't get list of OpenId services" if $response_code != 200; | 
| 145 |  |  |  |  |  |  |  | 
| 146 | 0 |  |  |  |  |  | my $response = decode_json($request->content); | 
| 147 |  |  |  |  |  |  |  | 
| 148 | 0 |  |  |  |  |  | $self->{services} = $response; | 
| 149 |  |  |  |  |  |  |  | 
| 150 | 0 |  |  |  |  |  | return 1; | 
| 151 |  |  |  |  |  |  | } | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | ################### ACESSORS ######################### | 
| 154 |  |  |  |  |  |  | sub getAccessToken { | 
| 155 | 0 |  |  | 0 | 1 |  | return $_[0]->{token}->{access_token}; | 
| 156 |  |  |  |  |  |  | } | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | sub getRefreshToken { | 
| 159 | 0 |  |  | 0 | 1 |  | return $_[0]->{token}->{refresh_token}; | 
| 160 |  |  |  |  |  |  | } | 
| 161 |  |  |  |  |  |  |  | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | =head1 NAME | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | B - Simple Google oauth api module | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | This module get acess_token and refresh_token from google oath | 
| 170 |  |  |  |  |  |  | use Net::Google::OAuth; | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | #Create oauth object. You need set client_id and client_secret value. Client_id and client_secret you can get on google, when register your app. | 
| 173 |  |  |  |  |  |  | my $oauth = Net::Google::OAuth->new( | 
| 174 |  |  |  |  |  |  | -client_id          => $CLIENT_ID, | 
| 175 |  |  |  |  |  |  | -client_secret      => $CLIENT_SECRET, | 
| 176 |  |  |  |  |  |  | ); | 
| 177 |  |  |  |  |  |  | #Generate link with request access token. This link you must copy to your browser and run. | 
| 178 |  |  |  |  |  |  | $oauth->generateAccessToken( | 
| 179 |  |  |  |  |  |  | -scope      => 'drive', | 
| 180 |  |  |  |  |  |  | -email      => 'youremail@gmail.com', | 
| 181 |  |  |  |  |  |  | ); | 
| 182 |  |  |  |  |  |  | print "Access token: ", $oauth->getAccessToken(), "\n"; | 
| 183 |  |  |  |  |  |  | print "Refresh token: ", $oauth->getRefreshToken, "\n"; | 
| 184 |  |  |  |  |  |  |  | 
| 185 |  |  |  |  |  |  | =head1 METHODS | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | =head2 new(%opt) | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | Create L object | 
| 190 |  |  |  |  |  |  |  | 
| 191 |  |  |  |  |  |  | %opt: | 
| 192 |  |  |  |  |  |  | -client_id          => Your app client id (Get from google when register your app) | 
| 193 |  |  |  |  |  |  | -client_secret      => Your app client secret (Get from google when register your app) | 
| 194 |  |  |  |  |  |  |  | 
| 195 |  |  |  |  |  |  | =head2 generateAccessToken(%opt) | 
| 196 |  |  |  |  |  |  |  | 
| 197 |  |  |  |  |  |  | Generate link with request access token This link you must copy to your browser and go it. Redirect answer you must copy to console. Return 1 if success, die in otherwise | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | %opt | 
| 200 |  |  |  |  |  |  | -scope              => Request access to scope (e.g. 'drive') | 
| 201 |  |  |  |  |  |  | -email              => Your gmail email | 
| 202 |  |  |  |  |  |  |  | 
| 203 |  |  |  |  |  |  | =head2 refreshToken(%opt) | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  | Get access token through refresh_token. Return 1 if success, die in otherwise | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | %opt: | 
| 208 |  |  |  |  |  |  | -refresh_token      => Your refresh token value (you can get refresh token after run method generateAccessToken() via getter getRefreshToken()) | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | =head2 getTokenInfo(%opt) | 
| 211 |  |  |  |  |  |  |  | 
| 212 |  |  |  |  |  |  | Get info about access token (access_type, audience, expires_in, issued_to, scope). Return hashref of result or die in otherwise | 
| 213 |  |  |  |  |  |  |  | 
| 214 |  |  |  |  |  |  | %opt: | 
| 215 |  |  |  |  |  |  | -access_token       => Value of access_token (default use value returned by method getRefreshToken()) | 
| 216 |  |  |  |  |  |  | Example: | 
| 217 |  |  |  |  |  |  | my $token_info = $oauth->getTokenInfo( -access_token => $access_token ); | 
| 218 |  |  |  |  |  |  | $token_info: | 
| 219 |  |  |  |  |  |  | { | 
| 220 |  |  |  |  |  |  | access_type   "offline", | 
| 221 |  |  |  |  |  |  | audience      "593952972427-e6dr18ua0leurrjt1num.apps.googleusercontent.com", | 
| 222 |  |  |  |  |  |  | expires_in    3558, | 
| 223 |  |  |  |  |  |  | issued_to     "593952972427-e6dr18ua0leurrjtum.apps.googleusercontent.com", | 
| 224 |  |  |  |  |  |  | scope         "https://www.googleapis.com/auth/drive" | 
| 225 |  |  |  |  |  |  | } | 
| 226 |  |  |  |  |  |  |  | 
| 227 |  |  |  |  |  |  |  | 
| 228 |  |  |  |  |  |  | =head2 getAccessToken() | 
| 229 |  |  |  |  |  |  |  | 
| 230 |  |  |  |  |  |  | Return access token value | 
| 231 |  |  |  |  |  |  |  | 
| 232 |  |  |  |  |  |  | =head2 getRefreshToken() | 
| 233 |  |  |  |  |  |  |  | 
| 234 |  |  |  |  |  |  | Return refresh token value | 
| 235 |  |  |  |  |  |  |  | 
| 236 |  |  |  |  |  |  | =head1 DEPENDENCE | 
| 237 |  |  |  |  |  |  |  | 
| 238 |  |  |  |  |  |  | L, L, L, L | 
| 239 |  |  |  |  |  |  |  | 
| 240 |  |  |  |  |  |  | =head1 AUTHORS | 
| 241 |  |  |  |  |  |  |  | 
| 242 |  |  |  |  |  |  | =over 4 | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | =item * | 
| 245 |  |  |  |  |  |  |  | 
| 246 |  |  |  |  |  |  | Pavel Andryushin | 
| 247 |  |  |  |  |  |  |  | 
| 248 |  |  |  |  |  |  | =back | 
| 249 |  |  |  |  |  |  |  | 
| 250 |  |  |  |  |  |  | =head1 COPYRIGHT AND LICENSE | 
| 251 |  |  |  |  |  |  |  | 
| 252 |  |  |  |  |  |  | This software is copyright (c) 2018 by Pavel Andryushin. | 
| 253 |  |  |  |  |  |  |  | 
| 254 |  |  |  |  |  |  | This is free software; you can redistribute it and/or modify it under | 
| 255 |  |  |  |  |  |  | the same terms as the Perl 5 programming language system itself. | 
| 256 |  |  |  |  |  |  |  | 
| 257 |  |  |  |  |  |  | =cut | 
| 258 |  |  |  |  |  |  |  | 
| 259 |  |  |  |  |  |  | 1; |