File Coverage

blib/lib/JSONRPC/Transport/TCP.pm

Criterion	Covered	Total	%
statement	24	87	27.5
branch	1	38	2.6
condition	0	21	0.0
subroutine	8	13	61.5
pod	4	4	100.0
total	37	163	22.7

package JSONRPC::Transport::TCP;
use strict;
use warnings;
use base qw/Class::Accessor::Fast/;

__PACKAGE__->mk_accessors(qw/result error/);

use IO::Select;
use IO::Socket::INET;
use IO::Socket::UNIX;
use Carp;

our $VERSION = '0.04';
our $XS_AVAILABLE = 1;

BEGIN {
    eval { require JSON::XS };
    if ($@) {
        $XS_AVAILABLE = 0;
        require JSON;
    }
}

=for stopwords Hostname Str tcp ip unix

=head1 NAME

JSONRPC::Transport::TCP - Client component for TCP JSONRPC

=head1 SYNOPSIS

    use JSONRPC::Transport::TCP;

    my $rpc = JSONRPC::Transport::TCP->new( host => '127.0.0.1', port => 3000 );
    my $res = $rpc->call('echo', 'arg1', 'arg2' )
        or die $rpc->error;

    print $res->result;

=head1 DESCRIPTION

This module is a simple client side implementation about JSONRPC via TCP.

This module doesn't support continual tcp streams, and so it open/close connection on each request.

=head1 METHODS

=head2 new

Create new client object.

Parameters:

=over

=item host => 'Str'

Hostname or ip address to connect.

This should be set 'unix/' when you want to connect to unix socket.

=item port => 'Int | Str'

Port number or unix socket path to connect

=back

=cut

sub new {
    my $self = shift->SUPER::new( @_ > 1 ? {@_} : $_[0] );

    $self->{id} = 0;
    $self->{json} ||= $XS_AVAILABLE ? JSON::XS->new->utf8 : JSON->new->utf8;
    $self->{delimiter} ||= q[];

    $self;
}

=head2 connect

Connect remote host.

This module automatically connect on following "call" method, so you have not to call this method.

=cut

sub connect {
    my $self = shift;
    my $params = @_ > 1 ? {@_} : $_[0];

    $self->disconnect if $self->{socket};

    my $socket;
    eval {
        # unix socket
        my $host = $params->{host} || $self->{host};
        my $port = $params->{port} || $self->{port};

        if ($host eq 'unix/') {
            $socket = IO::Socket::UNIX->new(
                Peer    => $port,
                Timeout => $self->{timeout} || 30,
            ) or croak qq/Unable to connect to unix socket "$port": $!/;
        }
        else {
            $socket = IO::Socket::INET->new(
                PeerAddr => $host,
                PeerPort => $port,
                Proto    => 'tcp',
                Timeout  => $self->{timeout} || 30,
            )
                or croak
                    qq/Unable to connect to "@{[ $params->{host}  || $self->{host} ]}:@{[ $params->{port}  || $self->{port} ]}": $!/;
        }

        $socket->autoflush(1);

        $self->{socket} = $socket;
    };
    if ($@) {
        $self->{error} = $@;
        return;
    }

    1;
}

=head2 disconnect

Disconnect the connection

=cut

sub disconnect {
    my $self = shift;
    delete $self->{socket} if $self->{socket};
}

=head2 call($method_name, @params)

Call remote method.

When remote method is success, it returns self object that contains result as ->result accessor.

If some error are occurred, it returns undef, and you can check the error by ->error accessor.

Parameters:

=over

=item $method_name

Remote method name to call

=item @params

Remote method parameters.

=back

=cut

sub call {
    my ($self, $method, @params) = @_;

    $self->connect unless $self->{socket};
    return unless $self->{socket};

    my $request = {
        id     => ++$self->{id},
        method => $method,
        params => \@params,
    };
    $self->{socket}->print($self->{json}->encode($request) . $self->{delimiter});

    my $timeout = $self->{socket}->timeout;
    my $limit   = time + $timeout;

    my $select = IO::Select->new or croak $!;
    $select->add($self->{socket});

    my $buf = '';

    while ($limit >= time) {
        my @ready = $select->can_read( $limit - time )
            or last;

        for my $s (@ready) {
            croak qq/$s isn't $self->{socket}/ unless $s eq $self->{socket};
        }

        unless (my $l = $self->{socket}->sysread( $buf, 512, length($buf) )) {
            my $e = $!;
            $self->disconnect;
            croak qq/Error reading: $e/;
        }

        my $json = eval { $self->{json}->incr_parse($buf) };

        if ($@) {
            $self->{error} = $@;
            $self->disconnect;
            return;
        }
        elsif ($json) {
            if ($json->{error}) {
                $self->{error} = $json->{error};
                $self->disconnect;
                return;
            }
            else {
                $self->{result} = $json->{result};
                $self->disconnect;
                return $self;
            }
        }
        else {
            $buf = '';
            next;
        }
    }

    croak "request timeout";
}

=head2 DESTROY

Automatically disconnect when object destroy.

=cut

sub DESTROY {
    my $self = shift;
    $self->disconnect;
}

=head1 ACCESSORS

=head2 result

Contains result of remote method

=head2 error

Contains error of remote method

=head1 AUTHOR

Daisuke Murase

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut

1;