File Coverage

blib/lib/JRPC.pm
Criterion Covered Total %
statement 15 98 15.3
branch 0 52 0.0
condition 0 3 0.0
subroutine 5 11 45.4
pod 3 6 50.0
total 23 170 13.5


line stmt bran cond sub pod time code
1             #{
2             package JRPC;
3 1     1   64897 use JSON::XS;
  1         2  
  1         53  
4 1     1   641 use Data::Dumper;
  1         5453  
  1         87  
5 1     1   17 use strict;
  1         1  
  1         28  
6 1     1   3 use warnings;
  1         1  
  1         695  
7              
8             #UNUSED:my $rstub = {'id' => 66666, 'jsonrpc' => '2.0'};
9             our $VERSION = '0.61';
10             # 0 = No validation (trust client, any exceptions thrown because of errors will
11             # be much lower level.)
12             # 1 = Validate method,params
13             # 2 = Require 'id','jsonrpc', 3
14             our $msgvalid = 1;
15             # This is prelogger callback. MUST be a _hard_ CODE ref to be used (not symbolic reference).
16             our $prelogger;
17              
18             =head1 NAME
19              
20             JRPC - Create JSON-RPC Services focusing on app logic, not worrying about the details of JSON-RPC Processing.
21              
22             =head1 SYNOPSIS
23              
24             use JRPC;
25             # Load one of the Service modules JRPC::CGI, JRPC::Apache2 or JRPC::Nginx
26             # See particular submodule documentation for the details.
27             use JRPC::CGI;
28              
29             =head1 DESCRIPTION
30              
31             JRPC Module bundle consists of Server and Client pieces for creating JSON-RPC services.
32             For the server piece it takes a slightly different approach than many other "API Heavy" CPAN modules.
33             Instead of assembing your service out of API calls, JRPC forms a framework on top of your implementation and
34             allows you to write a (single) callback:
35              
36             =over 4
37              
38             =item * receiving parameters (JSON-RPC "params") of the of JSON-RPC call pre-parsed, ready-to be worked with by your app code
39              
40             =item * returning the "result" data (to framework taking care of JSON-RPC)
41              
42             =back
43              
44             The callback should be wrapped into a class package. One package can host multiple service methods.
45              
46             When any exception is thrown (by die()) during the processing by callback, the framework takes care of turning this to an appropriate JSON-RPC fault.
47             The framework will also take care of dealing with JSON-RPC "envelope" (term borrowed from SOAP lingo) of both request and response, "unwrapping" it
48             on request and wrapping the result with it on response.
49              
50             package MyEchoService;
51             our $VERSION = '0.01';
52            
53             # Respond with whatever was sent
54             sub echo {
55             my ($param) = @_;
56             # Pass-through - Just send the "params" as "result"
57             return($param);
58             }
59              
60             =head1 DISPATCHING OF SERVICE REQUEST
61              
62             Dispatching of service request can use 2 methods:
63              
64             =over 4
65              
66             =item * URL based dispatching, where relative URL (after server name and port) defines the package and method name ("method" in JSON-RPC envelope) defines the runtime method
67              
68             =item * URL independent dispatching where method name with dot-notation defines the method name
69              
70             =back
71              
72             Currently the dispatching method is automatically chosen based on what is found in "method" member of JSON-RPC envelope.
73             Examples highlighting the (automatically) chosen dispatching method:
74              
75             =over 4
76              
77             =item * "method": "echo", URL "/MyEchoService" - Choose URL based dispatching, map relative URL to package and echo() method ( MyEchoService::echo() )
78              
79             =item * "method": "MyEchoService.echo" - Derive both Class and method from dot-notation ( MyEchoService::echo() )
80              
81             =back
82              
83             I'd recommend the latter as a more modern way of dispatching. Additionally (because of URL independence and need to "map" URL:s) it is less likely to require config changes in your web server.
84              
85             =head1 METHODS
86              
87             =head2 createfault($req, $msg, $errcode)
88              
89             Internal method to create a JSON-RPC Fault message.
90             As these parameters are coming from the server side code, they are trusted
91             (i.e. not validated) here. Parameters:
92              
93             =over 4
94              
95             =item * $msg - Message (typically originating from exceptions). Placed to member "message" of
96             "error" branch of fault (See JSON-RPC 2.0 spec for details).
97              
98             =item * $errcode - Numeric error code (must be given)
99              
100             =back
101              
102             Notice that the service methods should not be using this directly, but only be throwing exceptions.
103             As a current shortcoming, the service methods cannot set $errcode (Only basic string based exceptions are
104             currently allowed / accepted).
105              
106             This should not be called explicitly by service developer. Throw execptions in your service handler to have them
107             automatically converted to valid JSON-RPC faults by createfault().
108              
109             =cut
110             # =item * $data - ANY data to be attached to 'data' member of error/fault Object
111             sub createfault {
112 0     0 1   my ($req, $msg, $errcode) = @_; # , $data
113             # Create response stub HERE ????
114             # TODO: We could clone original or just pick 'id', 'jsonrpc' from it.
115 0           my $resp = {'jsonrpc' => '2.0'}; # $req ? $req : Storable::dclone($rstub);
116 0           $resp->{'id'} = $req->{'id'};
117             #$req->{'id'} = $msg->{'id'};
118 0           my $fault = $resp->{'error'} = {'message' => $msg, 'code' => $errcode, };
119             #if ($data) {$fault->{'data'} = $data;}
120             # Return data (structure) or serialized JSON ?
121             #if (1) {}
122 0           return(encode_json($resp));
123             # Return apache return values, such as Apache2::Const::OK ?
124             }
125             # Note - these package global lazy-cached tables have different formats.
126             # Single level dot-notation to service method (CODE) mapping.
127             our %dotn2func = ();
128             # Two level URL => method => service method (CODE) mapping.
129             our %urlm2func = ();
130              
131             #=head1 METHOD RESOLVER METHODS
132              
133             #Both resolvers (Explained earlier in doc) are able to cache package+method combos in lookup tables for accelerated resolution.
134             # Both have their own cache / mapping table (containing re-resolved methods) for this purpose.
135             #Both resolver methods return a hard (CODE) reference to service for the server to execute.
136              
137             # DONE: Build a pre-resolved method mapping table.
138             # TODO: Allow 'lazyload' for lazily loading modules on-demand.
139             # Should we do package AND method resolution in single method ?
140             sub methresolve_dotnot {
141 0     0 0   my ($r, $m) = @_;
142             # Support dot-notation (resolve_dotnot())
143 0 0         if ($m !~ /\./) {die("No dot-notation in method");} # Redundant check
  0            
144             # Resolved earlier, Pre-cached ?
145 0 0         if (my $f = $dotn2func{$m}) {return($f);}
  0            
146 0           my @pp = split(/\./, $m);
147 0           my $mcp = pop(@pp); # pop() (trailing) method
148            
149 0 0         if (!$mcp) {die("No method remaining for dotnot method resolution ($m)".Dumper(\@pp));}
  0            
150 0 0         if (!@pp) {die("No package path comps for dotnot method resolution ($m)".Dumper(\@pp));}
  0            
151            
152 0 0         if (my $f = join('::', @pp)->can($mcp)) {$dotn2func{$m} = $f;return($f);}
  0            
  0            
153 0           return(undef);
154            
155             }
156             # URL2package based Service Class/Method resolver
157             sub methresolve {
158 0     0 0   my ($r, $m) = @_;
159             # Extract Package from URL:
160             # get the global request object (requires PerlOptions +GlobalRequest)
161             #my $r = Apache2::RequestUtil->request;
162             # Thankfully both Apache2 and Nginx have this method
163 0           my $uri = $r->uri();
164 0 0         if (my $f = $urlm2func{$uri}->{$m}) {return($f);}
  0            
165 0           my @pp = split(/\//, $uri);
166             # Normalize components
167 0 0         if (!$pp[0]) {shift(@pp);}
  0            
168 0 0         if (!$pp[$#pp]) {pop(@pp);}
  0            
169             # $ENV{'SCRIPT_NAME'}
170             #my $dump = Dumper(\%ENV); # $dump
171 0 0 0       if (!@pp || !$pp[0]) {
172 0           die("No package comps for method resolution (uri=$uri)");
173             }
174 0           my $mcp = join('::', @pp);
175 0           my $f = $mcp->can($m);
176 0 0         if (!$f) {die("Tried meth '$m' from package: '$mcp'");return(undef);}
  0            
  0            
177             # Cache to a URL-to-method map (NOT methname-to-func)
178 0           $urlm2func{$uri}->{$m} = $f;
179 0           return($f);
180             #return("qmp"->can($m));
181             }
182              
183             =head2 parse($jsontext)
184              
185             Parse JSON-RPC Message and validate the essential parts of it. What is validated (per JSON-RPC spec):
186              
187             =over 4
188              
189             =item * method - must be non-empty
190              
191             =item * params - presence (of key) - even null (value) is okay.
192              
193             =item * id - JSON-RPC ID of message - must be present (format not strictly constrained)
194              
195             =item * jsonrpc - JSON-RPC protocol version (must be '2.0')
196              
197             =back
198              
199             The particular format of "params" (Object/Array/scalar) or individual parameter
200             validation in case of most common case "Object" is not in the scope here.
201              
202             =cut
203             # TODO: Allow application level constraining of "params" to certain type (e.g. HASH/Object)
204             sub parse { # JRPC::Msg::
205             #my ($buffer) = @_;
206 0     0 1   my $j = eval { decode_json($_[0]); }; # $buffer / $_[0]
  0            
207 0 0         if ($@) {die("Error Parsing JSON(-32700): $@");}
  0            
208            
209             # Error on batch requests
210 0 0         if (ref($j) eq 'ARRAY') {die("JSON-RPC Batch request not (yet) supported");}
  0            
211             # These validation steps have a slight cost (3800 => 3600 for simple
212             # method processing where relative framework overhead is major).
213             # Allow to skip them with a config
214             #if (!$msgvalid) {
215 0           return($j);
216             #}
217             #eval {
218             # In order of importance method and params are necessary.
219 0 0         if (!$j->{'method'}) {die("No 'method' found");}
  0            
220 0 0         if (!exists($j->{'params'})) {die("No 'params' found");} # !(not) enough ?
  0            
221 0 0         if ($msgvalid < 2) {return($j);}
  0            
222 0 0         if (!$j->{'id'}) {die("No 'id' found");}
  0            
223 0 0         if ($j->{'jsonrpc'} ne '2.0') {die("No jsonrpc version (2.0)found");}
  0            
224             # Still validate envelope and param top level format
225            
226             # Additional params format constraint validation (fmtvalidator func ?)
227             #if (my $fmt = $serv->{'pfmt'}) {}
228             #};
229 0 0         if ($@) {die("Invalid JSON-RPC Message (-32600): $@");}
  0            
230 0           return($j);
231             }
232              
233             #}; # END package JRPC;
234              
235             =head2 respond_async($client, $url, $meth, $p, %opts);
236              
237             After async processing, acknowledge the original client tier (or any URL) of the completion of the asynchronous part.
238             This method is experimental and the whole concept of using asynchronous processing at service is an unofficial extension
239             to standard JSON-RPC 2.0 protocol spec.
240              
241             Parameters:
242              
243             =over 4
244              
245             =item * $client - Instance of JRPC::Client. If not provided, a new client will be instantiated here.
246              
247             =item * $url - URL of the async callback - Must be provided
248              
249             =item * $meth - JSON-RPC Method to callback to on the server (default: "oncomplete")
250              
251             =item * $p - JSON-RPC "params" to send in completion acknowledgement (must be supplied, likely to be Object/Hash)
252              
253             =back
254              
255             If optional KW params in have param 'cb' set, it is used to process the response from callback service. The "result" of JSON-RPC response is passed to this callback.
256              
257             Return "result" of response (likely to be Object/Hash).
258              
259             =cut
260              
261             #Minor optimization for avoiding overhead of JRPC::Client instantiation in respond_async() (or during request) is to initialize it in the service package init() phase.
262              
263             # TODO: Example of combination of init and a call to respond_async()
264             # package MyPack;
265             # ...
266             #our $client;
267             #sub init {
268             # $client = JRPC::Client->new();
269             #}
270             #sub do_long_and_hard_work {
271             # my ($p) = @_;
272             #
273             #}
274             #TODO: Consider callback to handle specific response.
275             sub respond_async {
276 0     0 1   my ($client, $url, $meth, $p, %c) = @_;
277             #my $client = $opts{'client'}; # Allow passing client as optional ?
278             # Create a full JRPC::Client instance if not passed.
279 0 0         if (!$client) {$client = JRPC::Client->new();}
  0            
280 0 0         if (!$url) {die("No Callback URL passed");}
  0            
281 0 0         if (!$meth) {$meth = 'oncomplete';}
  0            
282 0 0         if (!$p) {die("No Parameters passed");}
  0            
283             # Always create a new request
284 0           my $req = $client->new_request($url); # Client does not know URL, request does.
285 0 0         if (!$req) {die("JSON-RPC Request not instantiated");}
  0            
286 0           my $resp = $req->call($meth, $p, 'notify' => 1); # Need eval ?
287 0 0         if (!$resp->is_success()) {die("HTTP Error: ".$resp->status_line());} # Status code ?
  0            
288             #DEBUG:print($fh "Resp from '$url': ".$resp->content()."\n");
289             # Server side may or may not care about this.
290             # By default consider response as non-important as handling various specific responses here would
291             # be hard.
292 0           my $result = $resp->result();
293             # Consider:Expect still a valid JSON response ? Parse it ?
294 1 0   1   4 if (my $f = $c{'cb'}) {no strict 'refs';$f->($result);}
  1         2  
  1         518  
  0            
  0            
295 0           return($result);
296             }
297              
298             #setup_pkg_as_server($classname)
299             # Setup a Service package as independent, runnable server w.o. hard-wiring any
300             # code into a server package. Handy for testing a serice package.
301             # Loads HTTP::Server::Simple::CGI, JRPC::CGI, Attaches the "handle_request" callback method as request handler.
302             # After this setup all that remains to be done is to run the server (not done here).
303             # Complete example of making "MyServPkg" run.
304             # use MyServPkg;
305             # my $port = $ENV{'JSONRPC_SERVICE_PORT'} || 8080;
306             # # Run in the same process
307             # MyServPkg->new($port)->run();
308             sub setup_pkg_as_server {
309 0     0 0   my ($class) = @_;
310             # Bootstrapping boilerplate. We are (almost completely) n control of of $boot string here,
311             # so eval is acceptable. Especially with validation of $class.
312 0 0         if ($class !~ /^[\w:]+$/) {die("Class does not look right");} # No spaces
  0            
313 0           my $boot =
314             "use HTTP::Server::Simple::CGI;\npush(\@$class\:\:ISA, 'HTTP::Server::Simple::CGI');\nuse JRPC::CGI;\n";
315 0           $boot .= "*$class\:\:handle_request = \\&JRPC::CGI::handle_simple_server_cgi;";
316             #print(STDERR "$boot");
317 0           eval("$boot");
318             }
319             1;
320             __END__