1############################################################################## 2# JSONRPC version 1.1 3# http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html 4############################################################################## 5 6use strict; 7use JSON (); 8use Carp (); 9 10############################################################################## 11 12package JSON::RPC::Client; 13 14$JSON::RPC::Client::VERSION = '0.93'; 15 16use LWP::UserAgent; 17 18 19BEGIN { 20 for my $method (qw/uri ua json content_type version id allow_call status_line/) { 21 eval qq| 22 sub $method { 23 \$_[0]->{$method} = \$_[1] if defined \$_[1]; 24 \$_[0]->{$method}; 25 } 26 |; 27 } 28} 29 30 31 32sub AUTOLOAD { 33 my $self = shift; 34 my $method = $JSON::RPC::Client::AUTOLOAD; 35 36 $method =~ s/.*:://; 37 38 return if ($method eq 'DESTROY'); 39 40 $method =~ s/^__(\w+)__$/$1/; # avoid to call built-in methods (ex. __VERSION__ => VERSION) 41 42 unless ( exists $self->allow_call->{ $method } ) { 43 Carp::croak("Can't call the method not allowed by prepare()."); 44 } 45 46 my @params = @_; 47 my $obj = { 48 method => $method, 49 params => (ref $_[0] ? $_[0] : [@_]), 50 }; 51 52 my $ret = $self->call($self->uri, $obj); 53 54 if ( $ret and $ret->is_success ) { 55 return $ret->result; 56 } 57 else { 58 Carp::croak ( $ret ? '(Procedure error) ' . $ret->error_message : $self->status_line ); 59 } 60 61} 62 63 64sub create_json_coder { 65 JSON->new->allow_nonref->utf8; 66} 67 68 69sub new { 70 my $proto = shift; 71 my $self = bless {}, (ref $proto ? ref $proto : $proto); 72 73 my $ua = LWP::UserAgent->new( 74 agent => 'JSON::RPC::Client/' . $JSON::RPC::Client::VERSION . ' beta ', 75 timeout => 10, 76 ); 77 78 $self->ua($ua); 79 $self->json( $proto->create_json_coder ); 80 $self->version('1.1'); 81 $self->content_type('application/json'); 82 83 return $self; 84} 85 86 87sub prepare { 88 my ($self, $uri, $procedures) = @_; 89 $self->uri($uri); 90 $self->allow_call({ map { ($_ => 1) } @$procedures }); 91} 92 93 94sub call { 95 my ($self, $uri, $obj) = @_; 96 my $result; 97 98 if ($uri =~ /\?/) { 99 $result = $self->_get($uri); 100 } 101 else { 102 Carp::croak "not hashref." unless (ref $obj eq 'HASH'); 103 $result = $self->_post($uri, $obj); 104 } 105 106 my $service = $obj->{method} =~ /^system\./ if ( $obj ); 107 108 $self->status_line($result->status_line); 109 110 if ($result->is_success) { 111 112 return unless($result->content); # notification? 113 114 if ($service) { 115 return JSON::RPC::ServiceObject->new($result, $self->json); 116 } 117 118 return JSON::RPC::ReturnObject->new($result, $self->json); 119 } 120 else { 121 return; 122 } 123} 124 125 126sub _post { 127 my ($self, $uri, $obj) = @_; 128 my $json = $self->json; 129 130 $obj->{version} ||= $self->{version} || '1.1'; 131 132 if ($obj->{version} eq '1.0') { 133 delete $obj->{version}; 134 if (exists $obj->{id}) { 135 $self->id($obj->{id}) if ($obj->{id}); # if undef, it is notification. 136 } 137 else { 138 $obj->{id} = $self->id || ($self->id('JSON::RPC::Client')); 139 } 140 } 141 else { 142 $obj->{id} = $self->id if (defined $self->id); 143 } 144 145 my $content = $json->encode($obj); 146 147 $self->ua->post( 148 $uri, 149 Content_Type => $self->{content_type}, 150 Content => $content, 151 Accept => 'application/json', 152 ); 153} 154 155 156sub _get { 157 my ($self, $uri) = @_; 158 $self->ua->get( 159 $uri, 160 Accept => 'application/json', 161 ); 162} 163 164 165 166############################################################################## 167 168package JSON::RPC::ReturnObject; 169 170$JSON::RPC::ReturnObject::VERSION = $JSON::RPC::VERSION; 171 172BEGIN { 173 for my $method (qw/is_success content jsontext version/) { 174 eval qq| 175 sub $method { 176 \$_[0]->{$method} = \$_[1] if defined \$_[1]; 177 \$_[0]->{$method}; 178 } 179 |; 180 } 181} 182 183 184sub new { 185 my ($class, $obj, $json) = @_; 186 my $content = ( $json || JSON->new->utf8 )->decode( $obj->content ); 187 188 my $self = bless { 189 jsontext => $obj->content, 190 content => $content, 191 }, $class; 192 193 $content->{error} ? $self->is_success(0) : $self->is_success(1); 194 195 $content->{version} ? $self->version(1.1) : $self->version(0) ; 196 197 $self; 198} 199 200 201sub is_error { !$_[0]->is_success; } 202 203sub error_message { 204 $_[0]->version ? $_[0]->{content}->{error}->{message} : $_[0]->{content}->{error}; 205} 206 207 208sub result { 209 $_[0]->{content}->{result}; 210} 211 212 213############################################################################## 214 215package JSON::RPC::ServiceObject; 216 217use base qw(JSON::RPC::ReturnObject); 218 219 220sub sdversion { 221 $_[0]->{content}->{sdversion} || ''; 222} 223 224 225sub name { 226 $_[0]->{content}->{name} || ''; 227} 228 229 230sub result { 231 $_[0]->{content}->{summary} || ''; 232} 233 234 235 2361; 237__END__ 238 239 240=pod 241 242 243=head1 NAME 244 245JSON::RPC::Client - Perl implementation of JSON-RPC client 246 247=head1 SYNOPSIS 248 249 use JSON::RPC::Client; 250 251 my $client = new JSON::RPC::Client; 252 my $url = 'http://www.example.com/jsonrpc/API'; 253 254 my $callobj = { 255 method => 'sum', 256 params => [ 17, 25 ], # ex.) params => { a => 20, b => 10 } for JSON-RPC v1.1 257 }; 258 259 my $res = $client->call($uri, $callobj); 260 261 if($res) { 262 if ($res->is_error) { 263 print "Error : ", $res->error_message; 264 } 265 else { 266 print $res->result; 267 } 268 } 269 else { 270 print $client->status_line; 271 } 272 273 274 # Easy access 275 276 $client->prepare($uri, ['sum', 'echo']); 277 print $client->sum(10, 23); 278 279 280=head1 DESCRIPTION 281 282This is JSON-RPC Client. 283See L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>. 284 285Gets a perl object and convert to a JSON request data. 286 287Sends the request to a server. 288 289Gets a response returned by the server. 290 291Converts the JSON response data to the perl object. 292 293 294=head1 JSON::RPC::Client 295 296=head2 METHODS 297 298=over 299 300=item $client = JSON::RPC::Client->new 301 302Creates new JSON::RPC::Client object. 303 304=item $response = $client->call($uri, $procedure_object) 305 306Calls to $uri with $procedure_object. 307The request method is usually C<POST>. 308If $uri has query string, method is C<GET>. 309 310About 'GET' method, 311see to L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html#GetProcedureCall>. 312 313Return value is L</JSON::RPC::ReturnObject>. 314 315 316=item $client->prepare($uri, $arrayref_of_procedure) 317 318Allow to call methods in contents of $arrayref_of_procedure. 319Then you can call the prepared methods with an array reference or a list. 320 321The return value is a result part of JSON::RPC::ReturnObject. 322 323 $client->prepare($uri, ['sum', 'echo']); 324 325 $res = $client->echo('foobar'); # $res is 'foobar'. 326 327 $res = $client->sum(10, 20); # sum up 328 $res = $client->sum( [10, 20] ); # same as above 329 330If you call a method which is not prepared, it will C<croak>. 331 332 333Currently, B<can't call any method names as same as built-in methods>. 334 335=item version 336 337Sets the JSON-RPC protocol version. 3381.1 by default. 339 340 341=item id 342 343Sets a request identifier. 344In JSON-RPC 1.1, it is optoinal. 345 346If you set C<version> 1.0 and don't set id, 347the module sets 'JSON::RPC::Client' to it. 348 349 350=item ua 351 352Setter/getter to L<LWP::UserAgent> object. 353 354 355=item json 356 357Setter/getter to the JSON coder object. 358Default is L<JSON>, likes this: 359 360 $self->json( JSON->new->allow_nonref->utf8 ); 361 362 $json = $self->json; 363 364This object serializes/deserializes JSON data. 365By default, returned JSON data assumes UTF-8 encoded. 366 367 368=item status_line 369 370Returns status code; 371After C<call> a remote procedure, the status code is set. 372 373=item create_json_coder 374 375(Class method) 376Returns a JSON de/encoder in C<new>. 377You can override it to use your favorite JSON de/encoder. 378 379 380=back 381 382 383=head1 JSON::RPC::ReturnObject 384 385C<call> method or the methods set by C<prepared> returns this object. 386(The returned JSON data is decoded by the JSON coder object which was passed 387by the client object.) 388 389=head2 METHODS 390 391=over 392 393=item is_success 394 395If the call is successful, returns a true, otherwise a false. 396 397=item is_error 398 399If the call is not successful, returns a true, otherwise a false. 400 401=item error_message 402 403If the response contains an error message, returns it. 404 405=item result 406 407Returns the result part of a data structure returned by the called server. 408 409=item content 410 411Returns the whole data structure returned by the called server. 412 413=item jsontext 414 415Returns the row JSON data. 416 417=item version 418 419Returns the version of this response data. 420 421=back 422 423=head1 JSON::RPC::ServiceObject 424 425 426=head1 RESERVED PROCEDURE 427 428When a client call a procedure (method) name 'system.foobar', 429JSON::RPC::Server look up MyApp::system::foobar. 430 431L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html#ProcedureCall> 432 433L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html#ServiceDescription> 434 435There is JSON::RPC::Server::system::describe for default response of 'system.describe'. 436 437 438=head1 SEE ALSO 439 440L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html> 441 442L<http://json-rpc.org/wiki/specification> 443 444=head1 AUTHOR 445 446Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt> 447 448 449=head1 COPYRIGHT AND LICENSE 450 451Copyright 2007-2008 by Makamaka Hannyaharamitu 452 453This library is free software; you can redistribute it and/or modify 454it under the same terms as Perl itself. 455 456=cut 457 458 459