package Reddit::Client::Request;
use strict;
use warnings;
use Carp;
use JSON qw/decode_json/;
use LWP::UserAgent qw//;
use HTTP::Request qw//;
use URI::Encode qw/uri_encode/;
use URI::Escape qw/uri_escape/; # next update, also line 122
use Data::Dumper;
require Reddit::Client;
use fields (
'user_agent',
'method',
'url',
'query',
'post_data',
'cookie',
'modhash',
'token',
'tokentype',
'request_errors',
'print_response',
'print_request',
);
sub new {
my ($class, %param) = @_;
my $self = fields::new($class);
$self->{user_agent} = $param{user_agent} || croak 'Expected "user_agent"';
$self->{url} = $param{url} || croak 'Expected "url"';
$self->{query} = $param{query};
$self->{post_data} = $param{post_data};
$self->{cookie} = $param{cookie};
$self->{modhash} = $param{modhash};
$self->{token} = $param{token};
$self->{tokentype} = $param{tokentype};
$self->{request_errors} = $param{request_errors} || 0;
$self->{print_response} = $param{print_response} || 0;
$self->{print_request} = $param{print_request} || 0;
if (defined $self->{query}) {
ref $self->{query} eq 'HASH' || croak 'Expected HASH ref for "query"';
$self->{url} = sprintf('%s?%s', $self->{url}, build_query($self->{query}))
}
if (defined $self->{post_data}) {
ref $self->{post_data} eq 'HASH' || croak 'Expected HASH ref for "post_data"';
}
$self->{method} = $param{method} || 'GET';
$self->{method} = uc $self->{method};
return $self;
}
sub build_query {
my $param = shift or return '';
my $opt = { encode_reserved => 1 };
join '&', map {uri_encode($_, $opt) . '=' . uri_encode($param->{$_}, $opt)} sort keys %$param;
}
sub build_request {
my $self = shift;
my $request = HTTP::Request->new();
$request->uri($self->{url});
$request->header("Authorization"=> "$self->{tokentype} $self->{token}") if $self->{tokentype} && $self->{token};
if ($self->{method} eq 'POST') {
my $post_data = $self->{post_data} || {};
$post_data->{modhash} = $self->{modhash} if $self->{modhash};
$post_data->{uh} = $self->{modhash} if $self->{modhash};
$request->method('POST');
$request->content_type('application/x-www-form-urlencoded');
$request->content(build_query($post_data));
} elsif ($self->{method} eq 'DELETE') {
$request->method('DELETE');
} elsif ($self->{method} eq 'PUT') {
my $post_data = $self->{post_data} || {};
$post_data->{modhash} = $self->{modhash} if $self->{modhash};
$post_data->{uh} = $self->{modhash} if $self->{modhash};
$request->method('PUT');
$request->content_type('application/x-www-form-urlencoded');
$request->content(build_query($post_data));
} else {
$request->method('GET');
}
return $request;
}
sub send {
my $self = shift;
my $request = $self->build_request;
Reddit::Client::DEBUG('%4s request to %s', $self->{method}, $self->{url});
my $ua = LWP::UserAgent->new(agent => $self->{user_agent}, env_proxy => 1);
my $res = $ua->request($request);
if ($self->{print_request}) {
print Dumper($request);
print Dumper($res);
} elsif ($self->{print_response}) {
print $res->content . "\n";
}
if ($res->is_success) {
return $res->content;
} else {
if ($self->{request_errors}) {
croak "Request error: HTTP ".$res->status_line .", Content: $res->{_content}";
} else {
croak sprintf("Request error: HTTP %s\n", $res->status_line);
}
#print "-- test -- \n";
#print Dumper($request);
#print Dumper($res);
# print_request overrides print_response since it contains the response
#die;
}
}
sub token_request {
my ($self, %param) = @_;
my $url = "https://$param{client_id}:$param{secret}\@www.reddit.com/api/v1/access_token";
my $ua = LWP::UserAgent->new(agent => $param{user_agent});
my $req = HTTP::Request->new(POST => $url);
$req->header('content-type' => 'application/x-www-form-urlencoded');
#my $postdata = "grant_type=password&username=$username&password=$password";
my $postdata;
if ($param{auth_type} eq 'script') {
$postdata = "grant_type=password&username=$param{username}&password=" . uri_escape($param{password});
} elsif ($param{auth_type} eq 'webapp') {
$postdata = "grant_type=refresh_token&refresh_token=".uri_escape($param{refresh_token});
} else { die "Request:token_request: invalid auth type"; }
$req->content($postdata);
my $res = $ua->request($req);
#dd $res;
if ($res->is_success) {
return $res->decoded_content;
} else {
croak sprintf('Request error: HTTP %s', $res->status_line);
}
}
sub refresh_token_request {
my ($self, %data) = @_;
# create user agent
my $ua = new LWP::UserAgent( agent=> $data{ua} );
# create new request
my $request = new HTTP::Request();
# set the request method
$request->method("POST");
# set request url
my $url = "https://$data{client_id}:$data{secret}\@www.reddit.com/api/v1/access_token";
$request->uri($url);
my $reqdata = {
grant_type => 'authorization_code',
code => $data{code},
redirect_uri=> $data{redirect_uri},
duration => 'permanent',
};
$request->content_type('application/x-www-form-urlencoded');
my $opt = { encode_reserved => 1 };
my $encoded = join '&', map { uri_encode($_, $opt) . '=' . uri_encode($reqdata->{$_}, $opt) } sort keys %$reqdata;
$request->content($encoded);
my $result = $ua->request($request);
if ($result->is_success) {
my $j = decode_json $result->content;
my $tok = $j->{refresh_token};
return $tok;
} else {
print "refresh_token_request: something went wrong\n";
print $result->status_line;
print $result->{_content};
if ($data{request_errors}) {
print Dumper($request);
print Dumper($result);
}
die;
}
}
1;
__END__
=pod
=head1 NAME
Reddit::Client::Request
=head1 DESCRIPTION
HTTP request driver for Reddit::Client. Uses LWP to perform GET and POST requests
to the reddit.com servers. This module is used internally by the Reddit::Client
and is not designed for external use.
=head1 SUBROUTINES/METHODS
=over
=item new(%params)
Creates a new Reddit::Request::API instance. Parameters:
user_agent User agent string
url Target URL
query Hash of query parameters
post_data Hash of POST parameters
cookie Reddit session cookie
modhash Reddit session modhash
=item build_query($query)
Builds a URI-escaped query string from a hash of query parameters. This is *not*
a method of the class, but a package routine.
=item build_request
Builds an HTTP::Request object for LWP::UserAgent.
=item send
Performs the HTTP request and returns the result. Croaks on HTTP error.
=back
=head1 AUTHOR
L<mailto:earthtone.rc@gmail.com>
=head1 LICENSE
BSD license
=cut