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;