File Coverage

lib/Net/OAuth2/AccessToken.pm
Criterion Covered Total %
statement 18 91 19.7
branch 0 18 0.0
condition 0 12 0.0
subroutine 6 35 17.1
pod 28 29 96.5
total 52 185 28.1


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::AccessToken;
10 4     4   419 use vars '$VERSION';
  4         5  
  4         190  
11             $VERSION = '0.66';
12              
13 4     4   18 use warnings;
  4         6  
  4         11900  
14 4     4   26 use strict;
  4         7  
  4         142  
15              
16             our $VERSION; # to be able to test in devel environment
17              
18 4     4   17 use JSON::MaybeXS qw/encode_json/;
  4         7  
  4         217  
19 4     4   23 use URI::Escape qw/uri_escape/;
  4         5  
  4         225  
20 4     4   465 use Encode qw/find_encoding/;
  4         8380  
  4         3916  
21              
22             # Attributes to be saved to preserve the session.
23             my @session = qw/access_token token_type refresh_token expires_at
24             scope state auto_refresh/;
25              
26             # This class name is kept for backwards compatibility: a better name
27             # would have been: Net::OAuth2::Session, with a ::Token::Bearer split-off.
28              
29             # In the future, most of this functionality will probably need to be
30             # split-off in a base class ::Token, to be shared with a new extension
31             # which supports HTTP-MAC tokens as proposed by ietf dragt
32             # http://datatracker.ietf.org/doc/draft-ietf-oauth-v2-http-mac/
33              
34              
35 0     0 1   sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) }
  0            
36              
37             sub init($)
38 0     0 0   { my ($self, $args) = @_;
39              
40             $self->{NOA_expires_at} = $args->{expires_at}
41 0   0       || ($args->{expires_in} ? time()+$args->{expires_in} : undef);
42              
43             # client is the pre-v0.50 name
44             my $profile = $self->{NOA_profile} = $args->{profile} || $args->{client}
45 0 0 0       or die "::AccessToken needs profile object";
46              
47 0           $self->{NOA_access_token} = $args->{access_token};
48 0           $self->{NOA_refresh_token} = $args->{refresh_token};
49 0           $self->{NOA_refresh_always}= $args->{refresh_always};
50 0           $self->{NOA_scope} = $args->{scope};
51 0           $self->{NOA_state} = $args->{state};
52 0           $self->{NOA_hd} = $args->{hd};
53 0           $self->{NOA_token_type} = $args->{token_type};
54 0           $self->{NOA_auto_refresh} = $args->{auto_refresh};
55 0           $self->{NOA_changed} = $args->{changed};
56              
57 0           $self->{NOA_error} = $args->{error};
58 0           $self->{NOA_error_uri} = $args->{error_uri};
59 0   0       $self->{NOA_error_descr} = $args->{error_description} || $args->{error};
60              
61 0           $self->{NOA_attr} = $args;
62 0           $self;
63             }
64              
65              
66             sub session_thaw($%)
67 0     0 1   { my ($class, $session) = (shift, shift);
68             # we can use $session->{net_oauth2_version} to upgrade the info
69 0           $class->new(%$session, @_);
70             }
71              
72             #--------------
73              
74 0     0 1   sub token_type() {shift->{NOA_token_type}}
75 0     0 1   sub scope() {shift->{NOA_scope}}
76 0     0 1   sub state() {shift->{NOA_state}}
77 0     0 1   sub hd() {shift->{NOA_hd}}
78 0     0 1   sub profile() {shift->{NOA_profile}}
79              
80              
81 0     0 1   sub attribute($) { $_[0]->{NOA_attr}{$_[1]} }
82              
83              
84             sub changed(;$)
85 0 0   0 1   { my $s = shift; @_ ? $s->{NOA_changed} = shift : $s->{NOA_changed} }
  0            
86              
87              
88             sub access_token()
89 0     0 1   { my $self = shift;
90              
91 0 0         if($self->expired)
    0          
92 0           { delete $self->{NOA_access_token};
93 0           $self->{NOA_changed} = 1;
94 0 0         $self->refresh if $self->auto_refresh;
95             }
96             elsif($self->refresh_always)
97 0           { $self->refresh;
98             }
99              
100 0           $self->{NOA_access_token};
101             }
102              
103             #---------------
104              
105 0     0 1   sub error() {shift->{NOA_error}}
106 0     0 1   sub error_uri() {shift->{NOA_error_uri}}
107 0     0 1   sub error_description() {shift->{NOA_error_descr}}
108              
109             #---------------
110              
111 0     0 1   sub refresh_token() {shift->{NOA_refresh_token}}
112 0     0 1   sub refresh_always() {shift->{NOA_refresh_always}}
113 0     0 1   sub auto_refresh() {shift->{NOA_auto_refresh}}
114              
115              
116 0     0 1   sub expires_at() { shift->{NOA_expires_at} }
117              
118              
119 0     0 1   sub expires_in() { shift->expires_at - time() }
120              
121              
122             sub expired(;$)
123 0     0 1   { my ($self, $after) = @_;
124 0 0         my $when = $self->expires_at or return;
125 0 0         $after = 15 unless defined $after;
126 0           $when < time() + $after;
127             }
128              
129              
130             sub update_token($$$;$)
131 0     0 1   { my ($self, $token, $type, $exp, $refresh) = @_;
132 0           $self->{NOA_access_token} = $token;
133 0 0         $self->{NOA_token_type} = $type if $type;
134 0           $self->{NOA_expires_at} = $exp;
135              
136 0 0         $self->{NOA_refresh_token} = $refresh
137             if defined $refresh;
138              
139 0           $token;
140             }
141              
142             #--------------
143              
144             sub to_json()
145 0     0 1   { my $self = shift;
146 0           encode_json $self->session_freeze;
147             }
148             *to_string = \&to_json; # until v0.50
149              
150              
151             sub session_freeze(%)
152 0     0 1   { my ($self, %args) = @_;
153 0           my %data = (net_oauth2_version => $VERSION);
154 0   0       defined $self->{"NOA_$_"} && ($data{$_} = $self->{"NOA_$_"}) for @session;
155 0           $self->changed(0);
156 0           \%data;
157             }
158              
159              
160             sub refresh()
161 0     0 1   { my $self = shift;
162 0           $self->profile->update_access_token($self);
163             }
164              
165             #--------------
166              
167 0     0 1   sub request{ my $s = shift; $s->profile->request_auth($s, @_) }
  0            
168 0     0 1   sub get { my $s = shift; $s->profile->request_auth($s, 'GET', @_) }
  0            
169 0     0 1   sub post { my $s = shift; $s->profile->request_auth($s, 'POST', @_) }
  0            
170 0     0 1   sub delete { my $s = shift; $s->profile->request_auth($s, 'DELETE', @_) }
  0            
171 0     0 1   sub put { my $s = shift; $s->profile->request_auth($s, 'PUT', @_) }
  0            
172              
173             1;