Group
Extension

LWP-Authen-OAuth2/lib/LWP/Authen/OAuth2/AccessToken.pm

package LWP::Authen::OAuth2::AccessToken;

# ABSTRACT: Access tokens for OAuth2.
our $VERSION = '0.20'; # VERSION

use strict;
use warnings;

use Carp qw(confess);
our @CARP_NOT = qw(LWP::Authen::OAuth2);


sub from_ref {
    my ($class, $data) = @_;
    # If create_time is passed, then that will overwrite this default.
    return bless {create_time => time(), %$data}, $class;
}


sub to_ref {
    my $self = shift;
    return { %$self };
}


sub expires_time {
    my $self = shift;
    my $initial_expires_in = $self->{expires_in} || 3600;
    return $self->{create_time} + $initial_expires_in;
}


sub expires_in {
    my $self = shift;
    return $self->expires_time - time();
}


sub should_refresh {
    my ($self, $early_refresh_time) = @_;
    # If the access tokens are short lived relative to $early_refresh_time
    # we cheat to avoid refreshing TOO often....
    if ($self->expires_in/2 < $early_refresh_time) {
        $early_refresh_time = $self->expires_in/2;
    }
    my $expires_in = $self->expires_in();
    if ($expires_in < $early_refresh_time) {
        return 1;
    }
    else {
        return 0;
    }
}


sub for_refresh {
    my $self = shift;
    if ($self->{refresh_token}) {
        return refresh_token => $self->{refresh_token};
    }
    else {
        return ();
    }
}


sub copy_refresh_from {
    my ($self, $other) = @_;
    if ($other->{refresh_token}) {
        $self->{refresh_token} ||= $other->{refresh_token};
    }
}


sub request {
    # Shift off one for easy redispatch to _request.
    my $self = shift;
    my ($oauth2, $request, @rest) = @_;
    if (
        $self->should_refresh($oauth2->{early_refresh_time} || 300) and
        $oauth2->can_refresh_tokens()
    ) {
        $oauth2->refresh_access_token();
        $self = $oauth2->access_token if ref($oauth2->access_token);
    }
    my ($response, $try_refresh) = $self->_request(@_);
    if ($try_refresh and $oauth2->can_refresh_tokens()) {
        # Someone's clock is wrong?  Try to refresh.
        $oauth2->refresh_access_token();
        if ($self->expires_in < $oauth2->access_token->expires_in) {
            # We seem to have renewed, try again.
            ($response, $try_refresh) = $oauth2->access_token->_request(@_);
        }
    }
    return $response;
}


sub _request {
    my ($self, $oauth2, $request, @rest) = @_;
    # ...
    # return ($response, $try_refresh);
    confess("Method _request needs to be overwritten.");
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

LWP::Authen::OAuth2::AccessToken - Access tokens for OAuth2.

=head1 VERSION

version 0.20

=head1 SYNOPSIS

This is a base class for signing API requests with OAuth2 access tokens.  A
subclass should override the C<request> method with something that knows how
to make a request, detect the need to try to refresh, and attmpts to do that.
See L<lWP::Authen::OAuth2::AccessToken::Bearer> for an example.

Subclasses of this one are not directly useful.  Please see
L<LWP::Authen::OAuth2> for the interface that you should be using.

=head1 METHODS

=head2 C<from_ref>

Construct an access token from a hash reference.  The default implementation
merely blesses it as an object, defaulting the C<create_time> field to the
current time.

    my $access_token = $class->from_ref($data);

If you roll your own, be aware that the fields C<refresh_token> and
C<_class> get used for purposes out of this class' control.  Any other fields
may be used.  Please die fatally if you cannot construct an object.

=head2 C<to_ref>

Construct an unblessed data structure to represent the object that can be
serialized as JSON.  The default implementation just creates a shallow copy
and assumes there are no blessed subobjects.

=head2 C<expires_time>

Estimate expiration time.  Not always correct, due to transit
delays, clock skew, etc.

=head2 C<expires_in>

Estimate the seconds until expiration.  Not always correct, due to transit
delays, clock skew, etc.

=head2 C<should_refresh>

Boolean saying whether a refresh should be emitted now.

=head2 C<for_refresh>

Returns key/value pairs for C<$oauth2> (and eventually the service provider
class) to use in trying to refresh.

=head2 C<copy_refresh_from>

Pass in a previous access token, copy anything needed to refresh.

=head2 C<request>

Make a request.  If expiration is detected, refreshing by the best
available method (if any).

    my $response = $access_token->request($oauth2, @request_for_lwp);

=head2 C<_request>

Make a request with no retry logic, and return a response, and a flag
for whether it is possible the access token is expired..

    my ($response, $try_refresh)
        = $access_token->_request($oauth2, @request_for_lwp);

B<THIS IS THE ONLY METHOD A SUBCLASS MUST OVERRIDE!>

=head1 AUTHORS

=over 4

=item *

Ben Tilly, <btilly at gmail.com>

=item *

Thomas Klausner <domm@plix.at>

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 - 2022 by Ben Tilly, Rent.com, Thomas Klausner.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.