File Coverage

blib/lib/JSON/RPC2/Client.pm

Criterion	Covered	Total	%
statement	121	121	100.0
branch	72	72	100.0
condition	34	34	100.0
subroutine	18	18	100.0
pod	10	10	100.0
total	255	255	100.0

package JSON::RPC2::Client;
use 5.010001;
use warnings;
use strict;
use utf8;
use Carp;

our $VERSION = 'v2.1.1';

use JSON::MaybeXS;
use Scalar::Util qw( weaken refaddr );


sub new {
    my ($class) = @_;
    my $self = {
        next_id     => 0,
        free_id     => [],
        call        => {},
        id          => {},
    };
    return bless $self, $class;
}

sub batch {
    my ($self, @requests) = @_;
    my @call  = grep {ref}  @requests;
    @requests = grep {!ref} @requests;
    croak 'at least one request required' if !@requests;
    my $request = '['.join(q{,}, @requests).']';
    return ($request, @call);
}

sub notify {
    my ($self, $method, @params) = @_;
    croak 'method required' if !defined $method;
    return encode_json({
        jsonrpc     => '2.0',
        method      => $method,
        (!@params ? () : (
        params      => \@params,
        )),
    });
}

sub notify_named {
    my ($self, $method, @params) = @_;
    croak 'method required' if !defined $method;
    croak 'odd number of elements in %params' if @params % 2;
    my %params = @params;
    return encode_json({
        jsonrpc     => '2.0',
        method      => $method,
        (!@params ? () : (
        params      => \%params,
        )),
    });
}

sub call {
    my ($self, $method, @params) = @_;
    croak 'method required' if !defined $method;
    my ($id, $call) = $self->_get_id();
    my $request = encode_json({
        jsonrpc     => '2.0',
        method      => $method,
        (!@params ? () : (
        params      => \@params,
        )),
        id          => $id,
    });
    return wantarray ? ($request, $call) : $request;
}

sub call_named {
    my ($self, $method, @params) = @_;
    croak 'method required' if !defined $method;
    croak 'odd number of elements in %params' if @params % 2;
    my %params = @params;
    my ($id, $call) = $self->_get_id();
    my $request = encode_json({
        jsonrpc     => '2.0',
        method      => $method,
        (!@params ? () : (
        params      => \%params,
        )),
        id          => $id,
    });
    return wantarray ? ($request, $call) : $request;
}

sub _get_id {
    my $self = shift;
    my $id = @{$self->{free_id}} ? pop @{$self->{free_id}} : $self->{next_id}++;
    my $call = {};
    $self->{call}{ refaddr($call) } = $call;
    $self->{id}{ $id } = $call;
    weaken($self->{id}{ $id });
    return ($id, $call);
}

sub pending {
    my ($self) = @_;
    return values %{ $self->{call} };
}

sub cancel {
    my ($self, $call) = @_;
    croak 'no such request' if !delete $self->{call}{ refaddr($call) };
    return;
}

sub batch_response {
    my ($self, $json) = @_;
    croak 'require 1 param' if @_ != 2;

    undef $@;
    my $response = ref $json ? $json : eval { decode_json($json) };
    if ($@) {
        return [ 'Parse error' ];
    }
    if ($response && ref $response eq 'HASH') {
        return [ $self->response($response) ];
    }
    if (!$response || ref $response ne 'ARRAY') {
        return [ 'expect Array or Object' ];
    }
    if (!@{$response}) {
        return [ 'empty Array' ];
    }

    return map {[ $self->response($_) ]} @{$response};
}

sub response {      ## no critic (ProhibitExcessComplexity RequireArgUnpacking)
    my ($self, $json) = @_;
    croak 'require 1 param' if @_ != 2;

    undef $@;
    my $response = ref $json ? $json : eval { decode_json($json) };
    if ($@) {
        return 'Parse error';
    }
    if (ref $response ne 'HASH') {
        return 'expect Object';
    }
    if (!defined $response->{jsonrpc} || $response->{jsonrpc} ne '2.0') {
        return 'expect {jsonrpc}="2.0"';
    }
    if (!exists $response->{id} || ref $response->{id} || !defined $response->{id}) {
        return 'expect {id} is scalar';
    }
    if (!exists $self->{id}{ $response->{id} }) {
        return 'unknown {id}';
    }
    if (!(exists $response->{result} xor exists $response->{error})) {
        return 'expect {result} or {error}';
    }
    if (exists $response->{error}) {
        my $e = $response->{error};
        if (ref $e ne 'HASH') {
            return 'expect {error} is Object';
        }
        if (!defined $e->{code} || ref $e->{code} || $e->{code} !~ /\A-?\d+\z/xms) {
            return 'expect {error}{code} is Integer';
        }
        if (!defined $e->{message} || ref $e->{message}) {
            return 'expect {error}{message} is String';
        }
        ## no critic (ProhibitMagicNumbers)
        if ((3 == keys %{$e} && !exists $e->{data}) || 3 < keys %{$e}) {
            return 'only optional key must be {error}{data}';
        }
    }

    my $id = $response->{id};
    push @{ $self->{free_id} }, $id;
    my $call = delete $self->{id}{ $id };
    if ($call) {
        $call = delete $self->{call}{ refaddr($call) };
    }
    if (!$call) {
        return; # call was canceled
    }
    return (undef, $response->{result}, $response->{error}, $call);
}


1; # Magic true value required at end of module
__END__