Net::OAuth::Simple - a simple wrapper round the OAuth protocol

    package Net::AppThatUsesOAuth;

    use strict;
    use base qw(Net::OAuth::Simple);




    sub new {
        my $class  = shift;
        my %tokens = @_;
        return $class->SUPER::new( tokens => \%tokens, 
                                   protocol_version => '1.0a',
                                   urls   => {
                                        authorization_url => ...,
                                        request_token_url => ...,
                                        access_token_url  => ...,
                                   });
    }

    sub view_restricted_resource {
        my $self = shift;
        my $url  = shift;
        return $self->make_restricted_request($url, 'GET');
    }

    sub update_restricted_resource {
        my $self         = shift;
        my $url          = shift;
        my %extra_params = @_;
        return $self->make_restricted_request($url, 'POST', %extra_params);    
    }
    1;

    # Get the tokens from the command line, a config file or wherever 
    my %tokens  = get_tokens(); 
    my $app     = Net::AppThatUsesOAuth->new(%tokens);

    # Check to see we have a consumer key and secret
    unless ($app->consumer_key && $app->consumer_secret) {
        die "You must go get a consumer key and secret from App\n";
    } 

    # If the app is authorized (i.e has an access token and secret)
    # Then look at a restricted resourse
    if ($app->authorized) {
        my $response = $app->view_restricted_resource;
        print $response->content."\n";
        exit;
    }




    # Otherwise the user needs to go get an access token and secret
    print "Go to ".$app->get_authorization_url."\n";
    print "Then hit return after\n";
    <STDIN>;

    my ($access_token, $access_token_secret) = $app->request_access_token;

    # Now save those values

    http://apiwiki.twitter.com/Twitter-REST-API-Method%3A-oauth-access_token-for-xAuth  

    x_auth_username
    x_auth_password
    x_auth_mode

    return_undef_on_error => 1

    package Net::AppUsingGoogleOAuth;
    use strict;
    use base qw(Net::OAuth::Simple);

    sub new {
        my $class  = shift;
        my %tokens = @_;
        return $class->SUPER::new(
            tokens => \%tokens, 
            urls   => {
                request_token_url => "https://www.google.com/accounts/OAuthGetRequestToken?scope=http://www-opensocial.googleusercontent.com/api/people",
                authorization_url => "https://www.google.com/accounts/OAuthAuthorizeToken",
                access_token_url  => "https://www.google.com/accounts/OAuthGetAccessToken",
            },
        );
    }

    package main;
    my $oauth = Net::AppUsingGoogleOAuth->new(%tokens);

    # Web application
    $app->redirect( $oauth->get_authorization_url( callback => "http://you.example.com/oauth/callback") );

    # Desktop application
    print "Open the URL and come back once you're authenticated!\n",
        $oauth->get_authorization_url;

    https://svn.unixbeard.net/simon/Net-OAuth-Simple

    perldoc Net::OAuth::Simple

package Net::OAuth::Simple;

use warnings;
use strict;
our $VERSION = "1.5";

use URI;
use LWP;
use CGI;
use HTTP::Request::Common ();
use Carp;
use Net::OAuth;
use Scalar::Util qw(blessed);
require Net::OAuth::Request;
require Net::OAuth::RequestTokenRequest;
require Net::OAuth::AccessTokenRequest;
require Net::OAuth::ProtectedResourceRequest;
require Net::OAuth::XauthAccessTokenRequest;

BEGIN {
    eval {  require Math::Random::MT };
    unless ($@) {
        Math::Random::MT->import(qw(srand rand));
    }
}

our @required_constructor_params = qw(consumer_key consumer_secret);
our @access_token_params         = qw(access_token access_token_secret);
our @general_token_params        = qw(general_token general_token_secret);
our $UNAUTHORIZED                = "Unauthorized.";

sub new {
    my $class  = shift;
    my %params = @_;
    $params{protocol_version} ||= '1.0a';
    my $client = bless \%params, $class;
    
    # Set up LibWWWPerl for HTTP requests
    $client->{browser} ||= LWP::UserAgent->new;

    # Verify arguments
    $client->_check;

   

    # Client Object
    return $client;
}

# Validate required constructor params
sub _check {
    my $self = shift;

    foreach my $param ( @required_constructor_params ) {
        unless ( defined $self->{tokens}->{$param} ) {
            return $self->_error("Missing required parameter '$param'");
        }
    }
    
    return $self->_error("browser must be a LWP::UserAgent")
        unless blessed $self->{browser} && $self->{browser}->isa('LWP::UserAgent');
}

sub oauth_1_0a {
    my $self = shift;
    return $self->{protocol_version } eq '1.0a';
}

sub authorized {
    my $self = shift;
    foreach my $param ( @access_token_params ) {
        return 0 unless defined $self->{tokens}->{$param} && length $self->{tokens}->{$param};
    }
    return 1;
}

sub signature_method {
    my $self = shift;
    $self->{signature_method} = shift if @_;
    return $self->{signature_method} || 'HMAC-SHA1';
}

sub tokens {
    my $self = shift;
    if (@_) {
        my %tokens = @_;
        $self->{tokens} = \%tokens;
    }
    return %{$self->{tokens}||{}};
}

sub consumer_key {
    my $self = shift;
    $self->_token('consumer_key', @_);
}

sub consumer_secret {
    my $self = shift;
    $self->_token('consumer_secret', @_);
}

sub access_token {
    my $self = shift;
    $self->_token('access_token', @_);
}

sub access_token_secret {
    my $self = shift;
    return $self->_token('access_token_secret', @_);
}

sub general_token {
     my $self = shift;
     $self->_token('general_token', @_);
}

sub general_token_secret {
    my $self = shift;
    $self->_token('general_token_secret', @_);
}

sub authorized_general_token {
     my $self = shift;
     foreach my $param ( @general_token_params ) {
        return 0 unless defined $self->$param();
     }
     return 1;
}

sub request_token {
    my $self = shift;
    $self->_token('request_token', @_);
}

sub request_token_secret {
    my $self = shift;
    return $self->_token('request_token_secret', @_);
}

sub verifier {
    my $self = shift;
    return $self->_param('verifier', @_);
}

sub callback {
    my $self = shift;
    $self->_param('callback', @_);
}

sub callback_confirmed {
    my $self = shift;
    $self->_param('callback_confirmed', @_);
}


sub _token {
    my $self = shift;
    $self->_store('tokens', @_);
}

sub _param {
    my $self = shift;
    $self->_store('params', @_);
}

sub _store {
    my $self = shift;
    my $ns   = shift;
    my $key  = shift;
    $self->{$ns}->{$key} = shift if @_;
    return $self->{$ns}->{$key};
}

sub authorization_url {
    my $self = shift;
    return $self->_url('authorization_url', @_);
}

sub request_token_url {
    my $self = shift;
    return $self->_url('request_token_url', @_);
}

sub access_token_url {
    my $self = shift;
    return $self->_url('access_token_url', @_);
}

sub _url {
    my $self = shift;
    my $key  = shift;
    $self->{urls}->{$key} = shift if @_;
    my $url  = $self->{urls}->{$key} || return;;
    return URI->new($url);
}

# generate a random number
sub _nonce {
    return int( rand( 2**32 ) );
}

sub request_access_token {
    my $self   = shift;
    my %params = @_;
    my $url    = $self->access_token_url;
    
    $params{token}        = $self->request_token        unless defined $params{token};
    $params{token_secret} = $self->request_token_secret unless defined $params{token_secret};
    
    if ($self->oauth_1_0a) {
        $params{verifier} = $self->verifier                             unless defined $params{verifier};
        return $self->_error("You must pass a verified parameter when using OAuth v1.0a") unless defined $params{verifier};
        
    }
    
    
    my $access_token_response = $self->_make_request(
        'Net::OAuth::AccessTokenRequest',
        $url, 'GET',
        %params,
    );

    return $self->_decode_tokens($url, $access_token_response);
}

sub _decode_tokens {
    my $self                  = shift;
    my $url                   = shift;
    my $access_token_response = shift;

    # Cast response into CGI query for EZ parameter decoding
    my $access_token_response_query =
      new CGI( $access_token_response->content );

    # Split out token and secret parameters from the access token response
    $self->access_token($access_token_response_query->param('oauth_token'));
    $self->access_token_secret($access_token_response_query->param('oauth_token_secret'));

    delete $self->{tokens}->{$_} for qw(request_token request_token_secret verifier);

    return $self->_error("ERROR: $url did not reply with an access token")
      unless ( $self->access_token && $self->access_token_secret );

    return ( $self->access_token, $self->access_token_secret );
    
}

sub xauth_request_access_token {
    my $self = shift;
    my %params = @_;
    my $url = $self->access_token_url;
    $url =~ s !^http:!https:!; # force https

    my %xauth_params = map { $_ => $params{$_} } 
        grep {/^x_auth_/}
        @{Net::OAuth::XauthAccessTokenRequest->required_message_params};

    my $access_token_response = $self->_make_request(
        'Net::OAuth::XauthAccessTokenRequest',
        $url, 'POST',
        %xauth_params,
    );

    return $self->_decode_tokens($url, $access_token_response);
}

sub request_request_token {
    my $self   = shift;
    my %params = @_;
    my $url    = $self->request_token_url; 
    
    if ($self->oauth_1_0a) {
        $params{callback} = $self->callback                             unless defined $params{callback};
        return $self->_error("You must pass a callback parameter when using OAuth v1.0a") unless defined $params{callback};
    }
          
    my $request_token_response = $self->_make_request(
        'Net::OAuth::RequestTokenRequest',
        $url, 'GET', 
        %params);

    return $self->_error("GET for $url failed: ".$request_token_response->status_line)
      unless ( $request_token_response->is_success );

    # Cast response into CGI query for EZ parameter decoding
    my $request_token_response_query =
      new CGI( $request_token_response->content );

    # Split out token and secret parameters from the request token response
    $self->request_token($request_token_response_query->param('oauth_token'));
    $self->request_token_secret($request_token_response_query->param('oauth_token_secret'));
    $self->callback_confirmed($request_token_response_query->param('oauth_callback_confirmed'));
    
    return $self->_error("Response does not confirm to OAuth1.0a. oauth_callback_confirmed not received")
     if $self->oauth_1_0a && !$self->callback_confirmed;

}

sub get_authorization_url {
    my $self   = shift;
    my %params = @_;
    my $url  = $self->authorization_url;
    if (!defined $self->request_token) {
        $self->request_request_token(%params);
    }
    $params{oauth_token} = $self->request_token;
    $url->query_form(%params);
    return $url;
}

sub make_restricted_request {
    my $self     = shift;

    return $self->_error($UNAUTHORIZED) unless $self->authorized;

    return $self->_restricted_request( $self->access_token, $self->access_token_secret, @_ );
}

sub make_general_request {
    my $self  = shift;

    croak $UNAUTHORIZED unless $self->authorized_general_token;

    return $self->_restricted_request( $self->general_token, $self->general_token_secret, @_ );
}

sub _restricted_request {
    my $self     = shift;
    my $token    = shift;
    my $secret   = shift;
    my $url      = shift;
    my $method   = shift;
    my %extras   = @_;
    my $response = $self->_make_request(
        'Net::OAuth::ProtectedResourceRequest',
        $url, $method,
        token            => $token,
        token_secret     => $secret,
        extra_params     => \%extras
    );
    return $response;
}

sub _make_request {
    my $self    = shift;
    my $class   = shift;
    my $url     = shift;
    my $method  = uc(shift);
    my @extra   = @_;

    my $uri   = URI->new($url);
    my %query = $uri->query_form;
    $uri->query_form({});
    
    my $request = $class->new(
        consumer_key     => $self->consumer_key,
        consumer_secret  => $self->consumer_secret,
        request_url      => $uri,
        request_method   => $method,
        signature_method => $self->signature_method,
        protocol_version => $self->oauth_1_0a ? Net::OAuth::PROTOCOL_VERSION_1_0A : Net::OAuth::PROTOCOL_VERSION_1_0,
        timestamp        => time,
        nonce            => $self->_nonce,
        extra_params     => \%query,
        @extra,
    );
    $request->sign;
    return $self->_error("COULDN'T VERIFY! Check OAuth parameters.")
      unless $request->verify;

    my @args    = ();
    my $req_url = $url;
    my $params  = $request->to_hash;
    if ('GET' eq $method || 'PUT' eq $method) {
        $req_url = URI->new($url);
        $req_url->query_form(%$params);
    } else {
        @args    = ( HTTP::Headers->new(%$params) );
    }
    
    my $req      = HTTP::Request->new( $method => $req_url, @args);
    my $response = $self->{browser}->request($req);
    return $self->_error("$method on $request failed: ".$response->status_line)
      unless ( $response->is_success );

    return $response;
}

sub _error {
    my $self = shift;
    my $mess = shift;
    if ($self->{return_undef_on_error}) {
        $self->{_last_error} = $mess;
    } else {
        croak $mess;
    }
    return undef;
}

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

sub load_tokens {
    my $class  = shift;
    my $file   = shift;
    my %tokens = ();
    return %tokens unless -f $file;

    open(my $fh, $file) || die "Couldn't open $file: $!\n";
    while (<$fh>) {
        chomp;
        next if /^#/;
        next if /^\s*$/;
        next unless /=/;
        s/(^\s*|\s*$)//g;
        my ($key, $val) = split /\s*=\s*/, $_, 2;
        $tokens{$key} = $val;
    }
    close($fh);
    return %tokens;
}

sub save_tokens {
    my $class  = shift;
    my $file   = shift;
    my %tokens = @_;

    my $max    = 0;
    foreach my $key (keys %tokens) {
        $max   = length($key) if length($key)>$max;
    }

    open(my $fh, ">$file") || die "Couldn't open $file for writing: $!\n";
    foreach my $key (sort keys %tokens) {
        my $pad = " "x($max-length($key));
        print $fh "$key ${pad}= ".$tokens{$key}."\n";
    }
    close($fh);
}

1; # End of Net::OAuth::Simple