view release on metacpan or  search on metacpan

lib/Net/OAuth2/Profile.pm  view on Meta::CPAN

use JSON::MaybeXS  qw/decode_json/;
use Scalar::Util   qw/blessed/;
use Encode         qw/encode/;

use constant MIME_URLENC => 'application/x-www-form-urlencoded';

# old names still supported:
#   bearer_token_scheme => token_scheme

sub new(@)
{   my $class = shift;
    $class ne __PACKAGE__
        or carp 'you need to create an extension, not base-class '.__PACKAGE__;
    (bless {}, $class)->init( {@_} );
}

# rfc6849 Appendix B, http://www.w3.org/TR/1999/REC-html401-19991224
sub _url_enc($)
{   my $x = encode 'utf8', shift;  # make bytes
    $x =~ s/([^A-Za-z0-9 ])/sprintf("%%%02x", ord $1)/ge;
    $x =~ s/ /+/g;
    $x; 
}

sub init($)
{   my ($self, $args) = @_;
    my $id     = $self->{NOP_id}     = $args->{client_id}
        or carp "profile needs id";
    my $secret = $self->{NOP_secret} = $args->{client_secret}
        or carp "profile needs secret";

    $self->{NOP_id_enc}      = _url_enc $id;
    $self->{NOP_secret_enc}  = _url_enc $secret;

    $self->{NOP_agent}       = $args->{user_agent} || LWP::UserAgent->new;
    $self->{NOP_scheme}      = $args->{token_scheme}
        || $args->{bearer_token_scheme} || 'auth-header:Bearer';
    $self->{NOP_scope}       = $args->{scope};
    $self->{NOP_state}       = $args->{state};
    $self->{NOP_hd}          = $args->{hd};
    $self->{NOP_method}      = $args->{access_token_method} || 'POST';
    $self->{NOP_acc_param}   = $args->{access_token_param} || [];
    $self->{NOP_init_params} = $args->{init_params};
    $self->{NOP_grant_type}  = $args->{grant_type};
    $self->{NOP_show_secret} = exists $args->{secrets_in_params}
      ? $args->{secrets_in_params} : 1;

    my $site = $self->{NOP_site}  = $args->{site};
    foreach my $c (qw/access_token protected_resource authorize refresh_token/)
    {   my $link = $args->{$c.'_url'} || $args->{$c.'_path'} || "/oauth/$c";
        $self->{"NOP_${c}_url"}    = $self->site_url($link);
        $self->{"NOP_${c}_method"} = $args->{$c.'_method'} || 'POST';
        $self->{"NOP_${c}_param"}  = $args->{$c.'_param'}  || [];
    }

    $self;
}

#----------------

sub id()         {shift->{NOP_id}}
sub id_enc()     {shift->{NOP_id_enc}}
sub secret()     {shift->{NOP_secret}}
sub secret_enc() {shift->{NOP_secret_enc}}
sub user_agent() {shift->{NOP_agent}}
sub site()       {shift->{NOP_site}}
sub scope()      {shift->{NOP_scope}}
sub state()      {shift->{NOP_state}}
sub hd()         {shift->{NOP_hd}}
sub grant_type() {shift->{NOP_grant_type}}

sub bearer_token_scheme() {shift->{NOP_scheme}}

#----------------

sub request($@)
{   my ($self, $request) = (shift, shift);
#print $request->as_string;
    my $response = $self->user_agent->request($request, @_);
#print $response->as_string;
#$response;
}


sub request_auth(@)
{   my ($self, $token) = (shift, shift);
    my $request;
    if(@_==1) { $request = shift }
    else
    {   my ($method, $uri, $header, $content) = @_;
        $request = HTTP::Request->new
          ( $method => $self->site_url($uri)
          , $header, $content
          );
    }
    $self->add_token($request, $token, $self->bearer_token_scheme);
    $self->request($request);
}

#--------------------

sub site_url($@)
{   my ($self, $path) = (shift, shift);
    my @params = @_==1 && ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
    my $site = $self->site;
    my $uri  = $site ? URI->new_abs($path, $site) : URI->new($path);
    $uri->query_form($uri->query_form, @params) if @params;
    $uri;
}


sub add_token($$$)
{   my ($self, $request, $token, $bearer) = @_;
    my $access  = $token->access_token;

    my ($scheme, $opt) = split ':', $bearer;
    $scheme = lc $scheme;
    if($scheme eq 'auth-header')
    {   # Specs suggest using Bearer or OAuth2 for this value, but OAuth
        # appears to be the de facto accepted value.
        # Going to use OAuth until there is wide acceptance of something else.
        my $auth_scheme = $opt || 'OAuth';
        $request->headers->header(Authorization => "$auth_scheme $access");
    }
    elsif($scheme eq 'uri-query')
    {   my $query_param = $opt || 'oauth_token';
        $request->uri->query_form($request->uri->query_form
          , $query_param => $access);
    }