File Coverage

lib/MojoX/JSON/RPC/Client.pm

Criterion	Covered	Total	%
statement	85	97	87.6
branch	34	52	65.3
condition	20	34	58.8
subroutine	18	19	94.7
pod	2	2	100.0
total	159	204	77.9

package MojoX::JSON::RPC::Client;

use Mojo::Base -base;
use Mojo::JSON qw(encode_json decode_json);
use Mojo::UserAgent;

has id           => undef;
has ua           => sub { Mojo::UserAgent->new };
has version      => '2.0';
has content_type => 'application/json';
has tx           => undef;                          # latest transaction

sub call {
    my ( $self, $uri, $body, $callback ) = @_;

    # body might be json already, only encode if necessary
    if ( ref $body eq 'HASH' || ref $body eq 'ARRAY' ) {
        foreach my $o ( ref $body eq 'HASH' ? $body : @{$body} ) {
            $o->{version} ||= $self->version;
        }
        $body = encode_json($body);
    }
    else {
        $body ||= q{};
    }

    # Always POST if $body is not empty!
    if ( ref $callback ne 'CODE' ) {
        if ( $body ne q{} ) {
            return $self->_process_result(
                $self->ua->post(
                    $uri, { 'Content-Type' => $self->content_type }, $body
                )
            );
        }
        elsif ( $uri =~ /\?/xms ) {
            return $self->_process_result( $self->ua->get($uri) );
        }
    }
    else {    # non-blocking
        if ( $body ne q{} ) {
            $self->ua->post(
                $uri,
                { 'Content-Type' => $self->content_type },
                $body,
                sub {    # callback
                    $callback->( $self->_process_result(pop) );
                },
            );
            return;
        }
        elsif ( $uri =~ /\?/xms ) {
            $self->ua->get(
                $uri => sub {    # callback
                    $callback->( $self->_process_result(pop) );
                }
            );
            return;
        }
    }
    return Carp::croak 'Cannot process call!';
}

# Prepare a Proxy object
sub prepare {
    my $self = shift;

    my %m = ();
URI:
    while ( my $uri = shift ) {
        my $methods = shift;

        # methods can be a name, a reference to a name or
        # a reference to an array of names
        if ( ref $methods eq 'SCALAR' ) {
            $methods = [$$methods];
        }
        elsif ( defined $methods && ref $methods eq q{} ) {
            $methods = [$methods];
        }
        if ( ref $methods ne 'ARRAY' ) {
            last URI;
        }
    METHOD:
        foreach my $method ( @{$methods} ) {
            if ( exists $m{$method} && $m{$method} ne $uri ) {
                Carp::croak qq{Cannot register method $method twice!};
            }
            $m{$method} = $uri;
        }
    }
    return bless {
        client  => $self,
        methods => \%m
        },
        'MojoX::JSON::RPC::Client::Proxy';
}

sub _process_result {
    my ( $self, $tx ) = @_;

    $self->tx($tx);    # save latest transaction

    my $tx_res = $tx->res;
    my $log = $self->ua->server->app->log if $self->ua->server->app;
    if ( $log && $log->is_level('debug') ) {
        $log->debug( 'TX BODY: [' . $tx_res->body . ']' );
    }

    # Check if RPC call is succesfull
    if ( !( $tx_res->is_success || $tx_res->is_client_error ) )
    {
        return;
    }

    my $decode_error;
    my $rpc_res;

    eval{ $rpc_res = decode_json( $tx_res->body || '{}' ); 1; } or $decode_error = $@;
    if ( $decode_error && $log ) {    # Server result cannot be parsed!
        $log->error( 'Cannot parse rpc result: ' . $decode_error );
        return;
    }

    # Return one or more ReturnObject's
    return ref $rpc_res eq 'ARRAY'
        ? [
        map {
            MojoX::JSON::RPC::Client::ReturnObject->new( rpc_response => $_ )
        } ( @{$rpc_res} )
        ]
        : MojoX::JSON::RPC::Client::ReturnObject->new(
        rpc_response => $rpc_res );
}

package MojoX::JSON::RPC::Client::Proxy;

use Carp;
use warnings;
use strict;

# no constructor defined. Object creation
# done by MojoX::JSON::RPC::Client.

our $AUTOLOAD;

# Dispatch calls
sub AUTOLOAD {
    my $self = shift;

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

    # We do not want to overload DESTROY
    if ( $method eq 'DESTROY' ) {
        return;
    }

    if ( !exists $self->{methods}->{$method} ) {
        Carp::croak "Unsupported method $method";
    }

    my $res = $self->{client}->call(
        $self->{methods}->{$method},
        {   id     => $self->{id}++,
            method => $method,
            params => \@_
        }
    );
    return defined $res ? $res->result : ();
}

package MojoX::JSON::RPC::Client::ReturnObject;

use Mojo::Base -base;

has rpc_response => undef;    # rpc response

sub result {
    my ($self) = @_;
    my $rpc_response = $self->rpc_response;
    return
        ref $rpc_response eq 'HASH' && exists $rpc_response->{result}
        ? $rpc_response->{result}
        : undef;
}

sub id {
    my ($self) = @_;
    my $rpc_response = $self->rpc_response;
    return
        ref $rpc_response eq 'HASH' && exists $rpc_response->{id}
        ? $rpc_response->{id}
        : undef;
}

sub is_error {
    my ($self) = @_;
    my $rpc_response = $self->rpc_response;
    return ref $rpc_response eq 'HASH' && exists $rpc_response->{error}
        ? 1
        : 0;
}

sub error_code {
    my ($self) = @_;
    return $self->is_error ? $self->rpc_response->{error}->{code} : undef;
}

sub error_message {
    my ($self) = @_;
    return $self->is_error ? $self->rpc_response->{error}->{message} : undef;
}

sub error_data {
    my ($self) = @_;
    return $self->is_error ? $self->rpc_response->{error}->{data} : undef;
}

1;

__END__