libnet-oauth-perl 0.28-2 / usr / share / perl5 / Net / OAuth / Client.pm

package Net::OAuth::Client;
use warnings;
use strict;
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw/id secret callback is_v1a user_agent site debug session/);
use LWP::UserAgent;
use URI;
use Net::OAuth;
use Net::OAuth::Message;
use Net::OAuth::AccessToken;
use Carp;

=head1 NAME

Net::OAuth::Client - OAuth 1.0A Client

=head1 SYNOPSIS

  # Web Server Example (Dancer)

  # This example is simplified for illustrative purposes, see the complete code in /demo

  # Note that client_id is the Consumer Key and client_secret is the Consumer Secret

  use Dancer;
  use Net::OAuth::Client;

  sub client {
  	Net::OAuth::Client->new(
  		config->{client_id},
  		config->{client_secret},
  		site => 'https://www.google.com/',
  		request_token_path => '/accounts/OAuthGetRequestToken?scope=https%3A%2F%2Fwww.google.com%2Fm8%2Ffeeds%2F',
  		authorize_path => '/accounts/OAuthAuthorizeToken',
  		access_token_path => '/accounts/OAuthGetAccessToken',
  		callback => uri_for("/auth/google/callback"),
  		session => \&session,
  	);
  }

  # Send user to authorize with service provider
  get '/auth/google' => sub {
  	redirect client->authorize_url;
  };

  # User has returned with token and verifier appended to the URL.
  get '/auth/google/callback' => sub {

  	# Use the auth code to fetch the access token
  	my $access_token =  client->get_access_token(params->{oauth_token}, params->{oauth_verifier});

  	# Use the access token to fetch a protected resource
  	my $response = $access_token->get('/m8/feeds/contacts/default/full');

  	# Do something with said resource...

  	if ($response->is_success) {
  	  return "Yay, it worked: " . $response->decoded_content;
  	}
  	else {
  	  return "Error: " . $response->status_line;
  	}
  };

  dance;

=head1 DESCRIPTION

Net::OAuth::Client represents an OAuth client or consumer.

WARNING: Net::OAuth::Client is alpha code.  The rest of Net::OAuth is quite
stable but this particular module is new, and is under-documented and under-tested.

  
=head1 METHODS

=over

=item new($client_id, $client_secret, %params)

Create a new Client

=over 

=item * $client_id

AKA Consumer Key - you get this from the service provider when you register your application.

=item * $client_secret

AKA Consumer Secret - you get this from the service provider when you register your application.

=item * $params{site}

=item * $params{request_token_path}

=item * $params{authorize_path}

=item * $params{access_token_path}

=item * $params{callback}

=item * $params{session}

=back

=back

=cut

sub new {
  my $class = shift;
  my $client_id = shift;
  my $client_secret = shift;
  my %opts = @_;
  $opts{user_agent} ||= LWP::UserAgent->new;
  $opts{id} = $client_id;
  $opts{secret} = $client_secret;
  $opts{is_v1a} = defined $opts{callback};
  my $self = bless \%opts, $class;
  return $self;
}

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

sub _parse_oauth_response {
  my $self = shift;
  my $do_what = shift;
  my $http_res = shift;
  my $msg = "Unable to $do_what: Request for " . $http_res->request->uri . " failed";
  unless ($http_res->is_success) {
    if ($self->debug) { 
      $msg .= "," . $http_res->as_string . " ";      
    }
    elsif (
      $http_res->content_type eq 'application/x-www-form-urlencoded'
      and $http_res->decoded_content =~ /\boauth_problem=(\w+)/
      ) { 
      $msg .= ", reason: " . $1;      
    }
    else {
      $msg .= ": " . $http_res->status_line . " (pass debug=>1 to Net::OAuth::Client->new to dump the entire response)";
    }
    croak $msg;
  }
  my $oauth_res = _parse_url_encoding($http_res->decoded_content);
  foreach my $k (qw/token token_secret/) {
    croak "Unable to $do_what: server response is missing '$k'" unless defined $oauth_res->{$k};
  }
  return $oauth_res;
  
}

sub _parse_url_encoding {
  my $str = shift;
  my @pairs = split '&', $str;
  my %params;
	foreach my $pair (@pairs) {
        my ($k,$v) = split /=/, $pair;
        if (defined $k and defined $v) {
            $v =~ s/(^"|"$)//g;
            ($k,$v) = map Net::OAuth::Message::decode($_), $k, $v;
            $k =~ s/^oauth_//;
            $params{$k} = $v;
        }
    }
	return \%params;
}

sub get_request_token {
  my $self = shift;
  my %params = @_;
  my $oauth_req = $self->_make_request(
    "request token", 
    request_method => $self->request_token_method,
    request_url => $self->_make_url("request_token"),
    %params
  );
  $oauth_req->sign;
  my $http_res = $self->request(HTTP::Request->new(
    $self->request_token_method => $oauth_req->to_url
  ));
  my $oauth_res = $self->_parse_oauth_response('get a request token', $http_res);
  $self->is_v1a(0) unless defined $oauth_res->{callback_confirmed};
  return $oauth_res;
}

sub authorize_url {
  my $self = shift;
  my %params = @_;
  # allow user to get request token their own way
  unless (defined $params{token} and defined $params{token_secret}) {
    my $request_token = $self->get_request_token;
    $params{token} = $request_token->{token};
    $params{token_secret} = $request_token->{token_secret};
  }
  if (defined $self->session) {
    $self->session->($params{token} => $params{token_secret});
  }
  my $oauth_req = $self->_make_request(
    'user auth',
    %params
  );
  return $oauth_req->to_url($self->_make_url('authorize'));
}

sub get_access_token {
  my $self = shift;
  my $token = shift;
  my $verifier = shift;
  my %params = @_;
  
  if (defined $self->session) {
    $params{token_secret} = $self->session->($token);
  }

  my $oauth_req = $self->_make_request(
    'access token', 
    request_method => $self->access_token_method,
    request_url => $self->_make_url('access_token'),
    token => $token,
    verifier => $verifier,
    %params
  );
  $oauth_req->sign;
  
  my $http_res = $self->request(HTTP::Request->new(
    $self->access_token_method => $oauth_req->to_url
  ));

  my $oauth_res = $self->_parse_oauth_response('get an access token', $http_res);
  
  return Net::OAuth::AccessToken->new(%$oauth_res, client => $self);
}

sub access_token_url {
  return shift->_make_url('access_token', @_);
}

sub request_token_url {
  return shift->_make_url('request_token', @_);
}

sub access_token_method {
  return shift->{access_token_method} || 'GET';
}

sub request_token_method {
  return shift->{request_token_method} || 'GET';
}

sub _make_request {
  my $self = shift;
  my $type = shift;
  my %params = @_;
  my %defaults = (
    nonce => int( rand( 2**32 ) ),
    timestamp => time,
    consumer_key => $self->id,
    consumer_secret => $self->secret,
    callback => $self->callback,
    signature_method => 'HMAC-SHA1',
    request_method => 'GET',
  );
  $defaults{protocol_version} = Net::OAuth::PROTOCOL_VERSION_1_0A if $self->is_v1a;
  my $req = Net::OAuth->request($type)->new(
    %defaults,
    %params
  );
  return $req;
}

sub _make_url {
  my $self = shift;
  my $thing = shift;
  my $path = $self->{"${thing}_url"} || $self->{"${thing}_path"} || "/oauth/${thing}";
  return $self->site_url($path, @_);
}

sub site_url {
  my $self = shift;
  my $path = shift;
  my %params = @_;
  my $url;
  if (defined $self->{site}) {
    $url = URI->new_abs($path, $self->{site});
  }
  else {
    $url = URI->new($path);
  }
  if (@_) {
    $url->query_form($url->query_form , %params);
  }
  return $url;
}



=head1 LICENSE AND COPYRIGHT

Copyright 2011 Keith Grennan.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut


1;


1;