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


line stmt bran cond sub pod time code
1             package MojoX::JSON::RPC::Client;
2              
3 3     3   2147 use Mojo::Base -base;
  3         6  
  3         16  
4 3     3   504 use Mojo::JSON qw(encode_json decode_json);
  3         12  
  3         124  
5 3     3   13 use Mojo::UserAgent;
  3         4  
  3         28  
6              
7             has id => undef;
8             has ua => sub { Mojo::UserAgent->new };
9             has version => '2.0';
10             has content_type => 'application/json';
11             has tx => undef; # latest transaction
12              
13             sub call {
14 37     37 1 4320 my ( $self, $uri, $body, $callback ) = @_;
15              
16             # body might be json already, only encode if necessary
17 37 100 100     138 if ( ref $body eq 'HASH' || ref $body eq 'ARRAY' ) {
18 30 100       62 foreach my $o ( ref $body eq 'HASH' ? $body : @{$body} ) {
  5         10  
19 36   33     157 $o->{version} ||= $self->version;
20             }
21 30         212 $body = encode_json($body);
22             }
23             else {
24 7   100     15 $body ||= q{};
25             }
26              
27             # Always POST if $body is not empty!
28 37 100       3488 if ( ref $callback ne 'CODE' ) {
29 35 100       73 if ( $body ne q{} ) {
    50          
30 33         75 return $self->_process_result(
31             $self->ua->post(
32             $uri, { 'Content-Type' => $self->content_type }, $body
33             )
34             );
35             }
36             elsif ( $uri =~ /\?/xms ) {
37 2         6 return $self->_process_result( $self->ua->get($uri) );
38             }
39             }
40             else { # non-blocking
41 2 50       5 if ( $body ne q{} ) {
    0          
42             $self->ua->post(
43             $uri,
44             { 'Content-Type' => $self->content_type },
45             $body,
46             sub { # callback
47 2     2   6288 $callback->( $self->_process_result(pop) );
48             },
49 2         6 );
50 2         1986 return;
51             }
52             elsif ( $uri =~ /\?/xms ) {
53             $self->ua->get(
54             $uri => sub { # callback
55 0     0   0 $callback->( $self->_process_result(pop) );
56             }
57 0         0 );
58 0         0 return;
59             }
60             }
61 0         0 return Carp::croak 'Cannot process call!';
62             }
63              
64             # Prepare a Proxy object
65             sub prepare {
66 1     1 1 283 my $self = shift;
67              
68 1         2 my %m = ();
69             URI:
70 1         5 while ( my $uri = shift ) {
71 2         3 my $methods = shift;
72              
73             # methods can be a name, a reference to a name or
74             # a reference to an array of names
75 2 50 66     10 if ( ref $methods eq 'SCALAR' ) {
    100          
76 0         0 $methods = [$$methods];
77             }
78             elsif ( defined $methods && ref $methods eq q{} ) {
79 1         4 $methods = [$methods];
80             }
81 2 50       5 if ( ref $methods ne 'ARRAY' ) {
82 0         0 last URI;
83             }
84             METHOD:
85 2         2 foreach my $method ( @{$methods} ) {
  2         4  
86 3 50 33     6 if ( exists $m{$method} && $m{$method} ne $uri ) {
87 0         0 Carp::croak qq{Cannot register method $method twice!};
88             }
89 3         10 $m{$method} = $uri;
90             }
91             }
92 1         12 return bless {
93             client => $self,
94             methods => \%m
95             },
96             'MojoX::JSON::RPC::Client::Proxy';
97             }
98              
99             sub _process_result {
100 37     37   80410 my ( $self, $tx ) = @_;
101              
102 37         127 $self->tx($tx); # save latest transaction
103              
104 37         457 my $tx_res = $tx->res;
105 37 50       151 my $log = $self->ua->server->app->log if $self->ua->server->app;
106 37 50 33     894 if ( $log && $log->is_level('debug') ) {
107 0         0 $log->debug( 'TX BODY: [' . $tx_res->body . ']' );
108             }
109              
110             # Check if RPC call is succesfull
111 37 50 66     333 if ( !( $tx_res->is_success || $tx_res->is_client_error ) )
112             {
113 0         0 return;
114             }
115              
116 37         594 my $decode_error;
117             my $rpc_res;
118            
119 37 50 100     55 eval{ $rpc_res = decode_json( $tx_res->body || '{}' ); 1; } or $decode_error = $@;
  37         75  
  37         23825  
120 37 50 33     100 if ( $decode_error && $log ) { # Server result cannot be parsed!
121 0         0 $log->error( 'Cannot parse rpc result: ' . $decode_error );
122 0         0 return;
123             }
124              
125             # Return one or more ReturnObject's
126             return ref $rpc_res eq 'ARRAY'
127             ? [
128             map {
129 8         34 MojoX::JSON::RPC::Client::ReturnObject->new( rpc_response => $_ )
130 37 100       155 } ( @{$rpc_res} )
  2         5  
131             ]
132             : MojoX::JSON::RPC::Client::ReturnObject->new(
133             rpc_response => $rpc_res );
134             }
135              
136             package MojoX::JSON::RPC::Client::Proxy;
137              
138 3     3   2480 use Carp;
  3         4  
  3         172  
139 3     3   28 use warnings;
  3         4  
  3         79  
140 3     3   13 use strict;
  3         15  
  3         627  
141              
142             # no constructor defined. Object creation
143             # done by MojoX::JSON::RPC::Client.
144              
145             our $AUTOLOAD;
146              
147             # Dispatch calls
148             sub AUTOLOAD {
149 4     4   16 my $self = shift;
150              
151 4         5 my $method = $AUTOLOAD;
152 4         23 $method =~ s/.*:://;
153              
154             # We do not want to overload DESTROY
155 4 100       11 if ( $method eq 'DESTROY' ) {
156 1         12 return;
157             }
158              
159 3 50       9 if ( !exists $self->{methods}->{$method} ) {
160 0         0 Carp::croak "Unsupported method $method";
161             }
162              
163             my $res = $self->{client}->call(
164             $self->{methods}->{$method},
165 3         15 { id => $self->{id}++,
166             method => $method,
167             params => \@_
168             }
169             );
170 3 50       32 return defined $res ? $res->result : ();
171             }
172              
173             package MojoX::JSON::RPC::Client::ReturnObject;
174              
175 3     3   19 use Mojo::Base -base;
  3         3  
  3         13  
176              
177             has rpc_response => undef; # rpc response
178              
179             sub result {
180 40     40   189 my ($self) = @_;
181 40         56 my $rpc_response = $self->rpc_response;
182             return
183             ref $rpc_response eq 'HASH' && exists $rpc_response->{result}
184             ? $rpc_response->{result}
185 40 100 66     230 : undef;
186             }
187              
188             sub id {
189 26     26   667 my ($self) = @_;
190 26         48 my $rpc_response = $self->rpc_response;
191             return
192             ref $rpc_response eq 'HASH' && exists $rpc_response->{id}
193             ? $rpc_response->{id}
194 26 50 33     157 : undef;
195             }
196              
197             sub is_error {
198 94     94   550 my ($self) = @_;
199 94         118 my $rpc_response = $self->rpc_response;
200             return ref $rpc_response eq 'HASH' && exists $rpc_response->{error}
201 94 100 66     423 ? 1
202             : 0;
203             }
204              
205             sub error_code {
206 14     14   43 my ($self) = @_;
207 14 50       22 return $self->is_error ? $self->rpc_response->{error}->{code} : undef;
208             }
209              
210             sub error_message {
211 14     14   73 my ($self) = @_;
212 14 50       20 return $self->is_error ? $self->rpc_response->{error}->{message} : undef;
213             }
214              
215             sub error_data {
216 14     14   71 my ($self) = @_;
217 14 50       17 return $self->is_error ? $self->rpc_response->{error}->{data} : undef;
218             }
219              
220             1;
221              
222             __END__