File Coverage

lib/LWP/Authen/OAuth2.pm

Criterion	Covered	Total	%
statement	61	188	32.4
branch	3	54	5.5
condition	1	21	4.7
subroutine	14	41	34.1
pod	23	30	76.6
total	102	334	30.5

package LWP::Authen::OAuth2;

# ABSTRACT: Make requests to OAuth2 APIs.
our $VERSION = '0.20'; # VERSION

use 5.006;
use strict;
use warnings;

use Carp qw(croak confess);
# LWP::UserAgent lazyloads these, but we always need it.
use HTTP::Request::Common;
use JSON qw(encode_json decode_json);
use LWP::UserAgent;
use Module::Load qw(load);

our @CARP_NOT = map "LWP::Authen::OAUth2::$_", qw(Args ServiceProvider);
use LWP::Authen::OAuth2::Args qw(
    extract_option copy_option assert_options_empty
);
use LWP::Authen::OAuth2::ServiceProvider;

sub new {
    my ($class, %opts) = @_;

    # Constructing the service provider can consume my options.
    my $service_provider = LWP::Authen::OAuth2::ServiceProvider->new(\%opts);
    my $self
        = bless {
              service_provider => $service_provider
          }, $service_provider->oauth2_class();
    $self->init(%opts, service_provider => $service_provider);
    return $self;
}

sub init {
    my ($self , %opts) = @_;

    # Collect arguments for the service providers.
    my $service_provider = $self->{service_provider};
    my $for_service_provider = LWP::Authen::OAuth2::Args->new();
    my %is_seen;
    for my $opt (@{ $service_provider->{required_init} }) {
        $is_seen{$opt}++;
        $for_service_provider->copy_option(\%opts, $opt);
    }
    for my $opt (@{ $service_provider->{optional_init} }) {
        if (not $is_seen{$opt}) {
            $is_seen{$opt}++;
            $for_service_provider->copy_option(\%opts, $opt, undef);
        }
    }
    $self->{for_service_provider} = $for_service_provider;

    $self->copy_option(\%opts, "early_refresh_time", 300);
    $self->copy_option(\%opts, "error_handler", undef);
    $self->copy_option(\%opts, "is_strict", 1);
    $self->copy_option(\%opts, "prerefresh", undef);
    $self->copy_option(\%opts, "save_tokens", undef);
    $self->copy_option(\%opts, "save_tokens_args", undef);
    $self->copy_option(\%opts, "token_string", undef);
    $self->copy_option(\%opts, "user_agent", undef);

    if ($self->{token_string}) {
        $self->load_token_string();
    }
}

# Standard shortcut request methods.
sub delete {
    my ($self, @parameters) = @_;
    my @rest = $self->user_agent->_process_colonic_headers(\@parameters,1);
    my $request = HTTP::Request::Common::DELETE(@parameters);
    return $self->request($request, @rest);
}

sub get {
    my ($self, @parameters) = @_;
    my @rest = $self->user_agent->_process_colonic_headers(\@parameters,1);
    my $request = HTTP::Request::Common::GET(@parameters);
    return $self->request($request, @rest);
}

sub head {
    my ($self, @parameters) = @_;
    my @rest = $self->user_agent->_process_colonic_headers(\@parameters,1);
    my $request = HTTP::Request::Common::HEAD(@parameters);
    return $self->request($request, @rest);
}

sub post {
    my ($self, @parameters) = @_;
    my @rest = $self->user_agent->_process_colonic_headers(\@parameters, (ref($parameters[1]) ? 2 : 1));
    my $request = HTTP::Request::Common::POST(@parameters);
    return $self->request($request, @rest);
}

sub put {
    my ($self, @parameters) = @_;
    my @rest = $self->user_agent->_process_colonic_headers(\@parameters, (ref($parameters[1]) ? 2 : 1));
    my $request = HTTP::Request::Common::PUT(@parameters);
    return $self->request($request, @rest);
}

sub request {
    my ($self, $request, @rest) = @_;
    return $self->access_token->request($self, $request, @rest);
}

# Now all of the methods that I need.
sub token_string {
    my $self = shift;
    if ($self->{access_token}) {
        my $ref = $self->{access_token}->to_ref;
        $ref->{_class} = ref($self->{access_token});
        return encode_json($ref);
    }
    else {
        return undef;
    }
}

# This does the actual saving.
sub _set_tokens {
    my ($self, %opts) = @_;

    my $tokens = $self->extract_option(\%opts, "tokens");
    my $skip_save = $self->extract_option(\%opts, "skip_save", 0);
    assert_options_empty(\%opts);

    if (ref($tokens)) {
        # Assume we have tokens.
        $self->{access_token} = $tokens;
        if ($self->{save_tokens} and not $skip_save) {
            my $as_string = $self->token_string;
            $self->{save_tokens}->($as_string, @{$self->{save_tokens_args}});
        }
        return;
    }
    else {
        # Assume we have an error message.
        return $self->error($tokens);
    }
}

sub authorization_url {
    my ($self, %opts) = @_;

    # If we get here, the service provider does it.
    my $url = $self->{service_provider}->authorization_url($self, %opts);
    if ($url =~ / /) {
        # Assume an error.
        return $self->error($url);
    }
    else {
        return $url;
    }
}

sub api_url_base {
    my $self = shift;
    return $self->{service_provider}->api_url_base || '';
}

sub make_api_call {
    my ($self, $uri, $params, $headers) = @_;
    my $url = $uri =~ m|^http| ? $uri : $self->api_url_base.$uri;
    if ($self->{service_provider}->can('default_api_headers')) {
        my $service_provider_headers = $self->{service_provider}->default_api_headers;
        $headers = ref $headers eq 'HASH' ? { %$headers, %$service_provider_headers } : $service_provider_headers || {};
    }

    my $response = $params ? $self->post($url, Content => encode_json($params), %$headers) : $self->get($url, %$headers);

    if (! $response->is_success()) {
        #$self->error('failed call to: '.$url.'; status_line='.$response->status_line.'; full error='.$response->error_as_HTML.'; content='.$response->content);
        $self->{'_api_call_error'} = $response->error_as_HTML || $response->status_line;
        return undef;
    }

    my $content = $response->content;
    return 1 if ! $content; # success
    return eval { decode_json($content) }; # return decoded JSON if response has a body
}

sub api_call_error { return shift->{'_api_call_error'}; }

sub request_tokens {
    my ($self, %opts) = @_;

    # If we get here, the service provider does it.
    my $tokens = $self->{service_provider}->request_tokens($self, %opts);
    # _set_tokens will set an error if needed.
    return $self->_set_tokens(tokens => $tokens);
}

sub can_refresh_tokens {
    my $self = shift;
    if (not $self->{access_token}) {
        return 0;
    }
    else {
        my %opts = ($self->{access_token}->for_refresh(), @_);
        return $self->{service_provider}->can_refresh_tokens($self, %opts);
    }
}

sub refresh_access_token {
    my $self = shift;
    if (not $self->{access_token}) {
        croak("Cannot try to refresh access token without tokens");
    }
    my %opts = ($self->{access_token}->for_refresh(), @_);

    # Give a chance for the hook to do it.
    if ($self->{prerefresh}) {
        my $tokens = $self->{prerefresh}->($self, %opts);
        if ($tokens) {
            if (not (ref($tokens))) {
                # Did I get JSON?
                my $data = eval {decode_json($tokens)};

                if ($data and not $@) {
                    my $class = $data->{_class} or croak("No _class in token_string '$tokens'");
                    eval {load($class)};
                    if ($@) { croak("Can't load access token class '$class': $@"); }
                    $tokens = $class->from_ref($data);
                }
            }
            return $self->_set_tokens(tokens => $tokens, skip_save => 1);
        }
    }

    my $tokens = $self->{service_provider}->refreshed_tokens($self, %opts);
    # _set_tokens will set an error if needed.
    return $self->_set_tokens(tokens => $tokens);
}

sub access_token {
    my $self = shift;

    return $self->{access_token};
}

sub should_refresh {
    my $self = shift;

    return $self->access_token->should_refresh($self->{early_refresh_time});
}

sub expires_time {
    my $self = shift;
    return 0 if ! $self->{access_token};
    return $self->access_token->expires_time;
}

sub set_early_refresh_time {
    my ($self, $early_refresh_time) = @_;
    $self->{early_refresh_time} = $early_refresh_time;
}

sub set_is_strict {
    my ($self, $strict) = @_;
    $self->{is_strict} = $strict;
}

sub is_strict {
    my $self = shift;
    return $self->{is_strict};
}

sub set_error_handler {
    my ($self, $handler) = @_;
    $self->{error_handler} = @_;
}

sub error {
    my $self = shift;
    if ($self->{error_handler}) {
        return $self->{error_handler}->(@_);
    }
    else {
        croak(@_);
    }
}

sub for_service_provider {
    my $self = shift;
    return $self->{for_service_provider} ||= {};
}

sub set_prerefresh {
    my ($self, $prerefresh) = @_;
    $self->{prerefresh} = $prerefresh;
}

sub set_save_tokens {
    my ($self, $save_tokens) = @_;
    $self->{save_tokens} = $save_tokens;
}

sub set_user_agent {
    my ($self, $agent) = @_;
    $self->{user_agent} = $agent;
}

sub load_token_string {
    my ($self, $token_string) = @_;
    $token_string ||= $self->{token_string};

    # Probably not the object that I need in access_token.
    my $tokens = eval{ decode_json($token_string) };
    if ($@) {
        croak("While decoding token_string: $@");
    }

    my $class = $tokens->{_class}
        or croak("No _class in token_string '$token_string'");

    eval {load($class)};
    if ($@) {
        croak("Can't load access token class '$class': $@");
    }

    # I will assume this works.
    $self->{access_token} = $class->from_ref($tokens);
}

sub user_agent {
    my $self = shift;
    return $self->{user_agent} ||= LWP::UserAgent->new();
}


1; # End of LWP::Authen::OAuth2

__END__