File Coverage

blib/lib/JSON/RPC/Simple/Client.pm

Criterion	Covered	Total	%
statement	59	66	89.3
branch	17	26	65.3
condition	6	9	66.6
subroutine	10	11	90.9
pod	1	1	100.0
total	93	113	82.3

package JSON::RPC::Simple::Client;

use strict;
use warnings;

use Carp qw(croak);
use LWP::UserAgent;
use JSON qw();
use URI::Escape qw();

require JSON::RPC::Simple;

use constant DEFAULT_TIMEOUT => 180;
use constant JSON_RPC_HTTP_HEADERS => (
    Content_Type        => "application/json; charset=UTF-8",
    Accept              => 'application/json',
);

sub new {
    my ($pkg, $uri, $attrs) = @_;

    $attrs = {} unless ref $attrs eq "HASH";

    my $agent = delete $attrs->{agent} || "JSON::RPC::Simple " .
                                          JSON::RPC::Simple->VERSION;

    my $ua = LWP::UserAgent->new(
        agent   => $agent,
        timeout => (
            exists $attrs->{timeout} ?
                delete $attrs->{timeout} :
                DEFAULT_TIMEOUT
        ),
    );

    my $get = $attrs->{GET};

    # Since the last component in GET call is the method name make sure we have a separator
    $uri .= "/" if $get && substr($uri, -1, 1) ne '/';

    my $self = bless {
        json => JSON->new->utf8,
        %$attrs,
        ua  => $ua,
        uri => $uri,
        GET => $get,
    }, $pkg;

    return $self;
}

sub DESTROY {
    # or AUTOLOAD will pick this up
}

my $next_request_id = 0;

our $AUTOLOAD;
sub AUTOLOAD {
    my ($self, $params) = @_;

    my $method = $AUTOLOAD;
    $method =~ s/.*:://;

    my $id = ++$next_request_id;

    my $r;

    my $sent = '';
    unless ($self->{GET}) {
        my $content = $self->{json}->encode({
            version => "1.1",
            method  => $method,
            params  => $params,
            id      => $id,
        });
        $sent = $content;

        $r = $self->{ua}->post(
            $self->{uri},
            JSON_RPC_HTTP_HEADERS,
            Content => $content,
        );
    }
    else {
        croak "GET only supports named parameters" if $params && ref $params ne 'HASH';
        $params = {} unless $params;

        my $params = join "&", map { "$_=" . URI::Escape::uri_escape_utf8($params->{$_}) } keys %$params;

        my $request_uri = $self->{uri} . $method . '?' . ${params};

        $r = $self->{ua}->get(
            $request_uri,
            JSON_RPC_HTTP_HEADERS,
        );
    }

    if ($r->is_success) {
        if ($r->content_type !~ /application\/json/) {
            croak("Bad response. Response was not type 'application/json'\n\nResponse:\n" . $r->decoded_content);
        }
    }
    else {
        croak $r->decoded_content unless $r->content_type =~ m{^application/json};
    }

    my $result;
    eval {
        my $content = $r->decoded_content;

        if ($self->{debug}) {
            print STDERR "RPC-Server: " . $self->{uri} . "\n\n";
            print STDERR "Sent: $sent\n";
            print STDERR "Recv: " . $r->decoded_content . "\n";
            print STDERR "\n";
        }

        $result = $self->{json}->decode($r->decoded_content);
    };
    croak $@ if $@;
    croak "Didn't get a JSON object back" unless ref $result eq "HASH";
    croak $result->{error}->{message} if $result->{error};

    return $result->{result};
}

1;
__END__