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__ =head1 NAME MojoX::JSON::RPC::Client - JSON RPC client =head1 SYNOPSIS use MojoX::JSON::RPC::Client; my $client = MojoX::JSON::RPC::Client->new; my $url = 'http://www.example.com/jsonrpc/API'; my $callobj = { id => 1, method => 'sum', params => [ 17, 25 ] }; my $res = $client->call($url, $callobj); if($res) { if ($res->is_error) { # RPC ERROR print 'Error : ', $res->error_message; } else { print $res->result; } } else { my $tx_res = $client->tx->res; # Mojo::Message::Response object print 'HTTP response '.$tx_res->code.' '.$tx_res->message; } Non-blocking: $client->call($url, $callobj, sub { # With callback my $res = pop; # ... process result ... Mojo::IOLoop->stop; }); Mojo::IOLoop->start; Easy access: my $proxy = $client->prepare($uri, ['sum', 'echo']); print $proxy->sum(10, 23); =head1 DESCRIPTION A JSON-RPC client. =head1 ATTRIBUTES L implements the following attributes. =head2 C Id used for JSON-RPC requests. Used when no id is provided as request parameter. =head2 C L object. =head2 C L object for encoding and decoding. =head2 C JSON-RPC version. Defaults to 2.0. =head2 C Content type. Defaults to application/json. =head2 C Mojo::Transaction object of last request. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 C Creates new MojoX::JSON::RPC::Client object. my $client = MojoX::JSON::RPC::Client->new; =head2 C Execute JSON-RPC call. Returns L if RPC call is executed correctly. my $client = MojoX::JSON::RPC::Client->new; my $url = 'http://www.example.com/jsonrpc/API'; my $callobj = { id => 1, method => 'sum', params => [ 17, 25 ] }; my $res = $client->call($url, $callobj); if($res) { if ($res->is_error) { # RPC error print 'Error : ', $res->error_message; } else { print $res->result; } } else { my $tx_res = $client->tx->res; # Mojo::Message::Response object print 'HTTP response '.$tx_res->code.' '.$tx_res->message; } Make non-blocking call: $client->call($url, $callobj, sub { # With callback my $res = pop; # ... process result ... Mojo::IOLoop->stop; }); Mojo::IOLoop->start; =head2 C Prepares a proxy object that allows RPC methods to be called more easily. my $proxy = $client->prepare($uri, ['sum', 'echo']); my $res = $proxy->sum(1, 2); print $proxy->echo("Echo this!"); Register services from multiple urls at once: my $proxy = $client->prepare($uri1, 'sum', $uri2, [ 'echo', 'ping' ]); my $res = $proxy->sum(1, 2); print $proxy->echo("Echo this!"); my $ping_res = $proxy->ping; =head1 C This object is returned by C. =head2 C RPC result. =head2 C Returns a boolean indicating whether an error code has been set. =head2 C RPC error code. =head2 C RPC error message. =head2 C RPC error data. =head1 SEE ALSO L =cut