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;