File Coverage

lib/Net/OAuth2/Profile/WebServer.pm
Criterion Covered Total %
statement 62 90 68.8
branch 4 16 25.0
condition 5 17 29.4
subroutine 18 24 75.0
pod 8 13 61.5
total 97 160 60.6


line stmt bran cond sub pod time code
1             # Copyrights 2013-2019 by [Mark Overmeer ].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.02.
5             # This code is part of distribution Net-OAuth2. Meta-POD processed
6             # with OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Net::OAuth2::Profile::WebServer;
10 4     4   78588 use vars '$VERSION';
  4         16  
  4         213  
11             $VERSION = '0.66';
12              
13 4     4   22 use base 'Net::OAuth2::Profile';
  4         7  
  4         1538  
14              
15 4     4   24 use warnings;
  4         6  
  4         88  
16 4     4   17 use strict;
  4         8  
  4         65  
17              
18 4     4   1120 use Net::OAuth2::AccessToken;
  4         9  
  4         115  
19 4     4   1740 use MIME::Base64 'encode_base64';
  4         2180  
  4         208  
20 4     4   21 use Scalar::Util 'blessed';
  4         7  
  4         175  
21              
22 4     4   20 use HTTP::Request ();
  4         14  
  4         50  
23 4     4   16 use HTTP::Response ();
  4         6  
  4         119  
24 4     4   20 use HTTP::Status qw(HTTP_TEMPORARY_REDIRECT);
  4         4  
  4         3554  
25              
26              
27             sub init($)
28 2     2 0 5 { my ($self, $args) = @_;
29 2   50     16 $args->{grant_type} ||= 'authorization_code';
30 2         10 $self->SUPER::init($args);
31 2         14 $self->{NOPW_redirect} = $args->{redirect_uri};
32 2         8 $self->{NOPW_referer} = $args->{referer};
33             $self->{NOPW_auto_save} = $args->{auto_save}
34 2   50 0   22 || sub { my $token = shift; $token->changed(1) };
  0         0  
  0         0  
35 2         9 $self;
36             }
37              
38             #-------------------
39              
40 2     2 1 6 sub redirect_uri() {shift->{NOPW_redirect}}
41             sub referer(;$)
42 3 50   3 1 4 { my $s = shift; @_ ? $s->{NOPW_referer} = shift : $s->{NOPW_referer} }
  3         14  
43 0     0 1 0 sub auto_save() {shift->{NOPW_auto_save}}
44              
45             #--------------------
46              
47             sub authorize(@)
48 1     1 1 1235 { my ($self, @req_params) = @_;
49              
50             # temporary, for backward compatibility warning
51 1         8 my $uri_base = $self->SUPER::authorize_url;
52             # my $uri_base = $self->authorize_url;
53              
54 1 50 33     19 my $uri = blessed $uri_base && $uri_base->isa('URI')
55             ? $uri_base->clone : URI->new($uri_base);
56              
57 1         9 my $params = $self->authorize_params(@req_params);
58 1         5 $uri->query_form($uri->query_form, %$params);
59 1         116 $uri;
60             }
61              
62             # Net::OAuth2 returned the url+params here, but this should return the
63             # accessor to the parameter with this name. The internals of that code
64             # was so confused that it filled-in the params multiple times.
65             sub authorize_url()
66 1     1 0 8 { require Carp;
67 1         178 Carp::confess("do not use authorize_url() but authorize()! (since v0.50)");
68             }
69              
70              
71             sub authorize_response(;$)
72 0     0 1 0 { my ($self, $request) = @_;
73 0         0 my $resp = HTTP::Response->new
74             ( HTTP_TEMPORARY_REDIRECT => 'Get authorization grant'
75             , [ Location => $self->authorize ]
76             );
77 0 0       0 $resp->request($request) if $request;
78 0         0 $resp;
79             }
80              
81              
82             sub get_access_token($@)
83 0     0 1 0 { my ($self, $code, @req_params) = @_;
84              
85 0         0 my $params = $self->access_token_params(code => $code, @req_params);
86              
87 0         0 my $request = $self->build_request
88             ( $self->access_token_method
89             , $self->access_token_url
90             , $params
91             );
92              
93 0         0 my $basic = encode_base64 "$params->{client_id}:$params->{client_secret}"
94             , ''; # no new-lines!
95              
96 0         0 $request->headers->header(Authorization => "Basic $basic");
97 0         0 my $response = $self->request($request);
98              
99 0         0 Net::OAuth2::AccessToken->new
100             ( profile => $self
101             , auto_refresh => !!$self->auto_save
102             , $self->params_from_response($response, 'access token')
103             );
104             }
105              
106              
107             sub update_access_token($@)
108 0     0 1 0 { my ($self, $access, @req_params) = @_;
109 0 0       0 my $refresh = $access->refresh_token
110             or die 'unable to refresh token without refresh_token';
111              
112 0         0 my $req = $self->build_request
113             ( $self->refresh_token_method
114             , $self->refresh_token_url
115             , $self->refresh_token_params(refresh_token => $refresh, @req_params)
116             );
117              
118 0         0 my $resp = $self->request($req);
119 0         0 my %data = $self->params_from_response($resp, 'update token');
120              
121             my $token = $data{access_token}
122 0 0       0 or die "no access token found in refresh data";
123              
124 0         0 my $type = $data{token_type};
125              
126             my $exp = $data{expires_in}
127 0 0       0 or die "no expires_in found in refresh data";
128              
129 0         0 $access->update_token($token, $type, $exp+time(), $data{refresh_token});
130             }
131              
132             sub authorize_params(%)
133 1     1 0 3 { my $self = shift;
134 1         5 my $params = $self->SUPER::authorize_params(@_);
135 1   50     5 $params->{response_type} ||= 'code';
136              
137             # should not be required: usually the related between client_id and
138             # redirect_uri is fixed to avoid security issues.
139 1         28 my $r = $self->redirect_uri;
140 1 50 0     19 $params->{redirect_uri} ||= $r if $r;
141              
142 1         3 $params;
143             }
144              
145             sub access_token_params(%)
146 1     1 0 2 { my $self = shift;
147 1         8 my $params = $self->SUPER::access_token_params(@_);
148 1   33     5 $params->{redirect_uri} ||= $self->redirect_uri;
149 1         1 $params;
150             }
151              
152             sub refresh_token_params(%)
153 0     0 0 0 { my $self = shift;
154 0         0 my $params = $self->SUPER::refresh_token_params(@_);
155 0   0     0 $params->{grant_type} ||= 'refresh_token';
156 0         0 $params;
157             }
158              
159             #--------------------
160              
161             sub build_request($$$)
162 3     3 1 2890 { my $self = shift;
163 3         16 my $request = $self->SUPER::build_request(@_);
164              
165 3 50       8 if(my $r = $self->referer)
166 0         0 { $request->header(Referer => $r);
167             }
168              
169 3         7 $request;
170             }
171              
172             #--------------------
173              
174             1;