The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Reddit::Client::Request;

use strict;
use warnings;
use Carp;

use LWP::UserAgent qw//;
use HTTP::Request  qw//;
use URI::Encode    qw/uri_encode/;

require Reddit::Client;

use fields (
    'user_agent',
    'method',
    'url',
    'query',
    'post_data',
    'cookie',
    'modhash',
);

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};

    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('Cookie', sprintf('reddit_session=%s', $self->{cookie}))
        if $self->{cookie};

    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));
    } 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 ($res->is_success) {
        return $res->content;
    } else {
        croak sprintf('Request error: HTTP %s', $res->status_line);
    }
}

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

Jeff Ober L<mailto:jeffober@gmail.com>

=head1 LICENSE

BSD license

=cut