File Coverage

blib/lib/JSON/RPC/Dispatch.pm
Criterion Covered Total %
statement 111 117 94.8
branch 34 40 85.0
condition 4 5 80.0
subroutine 18 18 100.0
pod 0 5 0.0
total 167 185 90.2


line stmt bran cond sub pod time code
1             package JSON::RPC::Dispatch;
2 2     2   63404 use strict;
  2         4  
  2         65  
3 2     2   404 use JSON::RPC::Constants qw(:all);
  2         4  
  2         293  
4 2     2   1068 use JSON::RPC::Parser;
  2         6  
  2         60  
5 2     2   12 use JSON::RPC::Procedure;
  2         4  
  2         40  
6 2     2   1788 use Router::Simple;
  2         7656  
  2         63  
7 2     2   15 use Scalar::Util;
  2         3  
  2         79  
8 2     2   1854 use Try::Tiny;
  2         3157  
  2         135  
9              
10             use Class::Accessor::Lite
11 2         15 rw => [ qw(
12             coder
13             handlers
14             parser
15             prefix
16             router
17             ) ]
18 2     2   12 ;
  2         3  
19              
20             sub new {
21 2     2 0 5299 my ($class, @args) = @_;
22 2         13 my $self = bless {
23             handlers => {},
24             @args,
25             }, $class;
26 2 100       12 if (! $self->{coder}) {
27 1         7 require JSON;
28 1         18 $self->{coder} = JSON->new->utf8;
29             }
30 2 100       9 if (! $self->{parser}) {
31 1         6 $self->{parser} = JSON::RPC::Parser->new( coder => $self->coder )
32             }
33 2 100       25 if (! $self->{router}) {
34 1         9 $self->{router} = Router::Simple->new;
35             }
36 2         11 return $self;
37             }
38              
39             sub guess_handler_class {
40 9     9 0 12 my ($self, $klass) = @_;
41              
42 9   50     25 my $prefix = $self->prefix || '';
43 9         59 return "$prefix\::$klass";
44             }
45              
46             sub construct_handler {
47 9     9 0 12 my ($self, $klass) = @_;
48              
49 9         25 my $handler = $self->handlers->{ $klass };
50 9 100       55 if (! $handler) {
51 1         56 eval "require $klass";
52 1 50       5 die if $@;
53 1         7 $handler = $klass->new();
54 1         8 $self->handlers->{$klass} = $handler;
55             }
56 9         17 return $handler;
57             }
58              
59             sub get_handler {
60 11     11 0 16 my ($self, $klass) = @_;
61              
62 11 100       36 if ( Scalar::Util::blessed( $klass )){
63 2         3 if (JSONRPC_DEBUG > 1) {
64             warn "Handler is already object : $klass";
65             }
66 2         16 return $klass;
67             }
68              
69 9 50       24 if ($klass !~ s/^\+//) {
70 9         26 $klass = $self->guess_handler_class( $klass );
71             }
72              
73 9         34 my $handler = $self->construct_handler( $klass );
74 9         11 if (JSONRPC_DEBUG > 1) {
75             warn "$klass -> $handler";
76             }
77 9         16 return $handler;
78             }
79              
80             sub handle_psgi {
81 16     16 0 29 my ($self, $req, @args) = @_;
82              
83 16 50       72 if ( ! Scalar::Util::blessed($req) ) {
84             # assume it's a PSGI hash
85 16         117 require Plack::Request;
86 16         98 $req = Plack::Request->new($req);
87             }
88              
89 16         193 my @response;
90             my $procedures;
91             try {
92 16     16   393 $procedures = $self->parser->construct_from_req( $req );
93 13 100       72 if (@$procedures <= 0) {
94 1         6 push @response, {
95             error => {
96             code => RPC_INVALID_REQUEST,
97             message => "Could not find any procedures"
98             }
99             };
100             }
101             } catch {
102 3     3   152 my $e = $_;
103 3         34 if (JSONRPC_DEBUG) {
104             warn "error while creating jsonrpc request: $e";
105             }
106 3 100       18 if ($e =~ /Invalid parameter/) {
    100          
107 1         7 push @response, {
108             error => {
109             code => RPC_INVALID_PARAMS,
110             message => "Invalid parameters",
111             }
112             };
113             } elsif ( $e =~ /parse error/ ) {
114 1         7 push @response, {
115             error => {
116             code => RPC_PARSE_ERROR,
117             message => "Failed to parse json",
118             }
119             };
120             } else {
121 1         6 push @response, {
122             error => {
123             code => RPC_INVALID_REQUEST,
124             message => $e
125             }
126             }
127             }
128 16         116 };
129              
130 16         270 my $router = $self->router;
131 16         92 foreach my $procedure (@$procedures) {
132 14 50       47 if ( ! $procedure->{method} ) {
133 0         0 my $message = "Procedure name not given";
134 0         0 if (JSONRPC_DEBUG) {
135             warn $message;
136             }
137 0         0 push @response, {
138             error => {
139             code => RPC_METHOD_NOT_FOUND,
140             message => $message,
141             }
142             };
143 0         0 next;
144             }
145              
146 14   100     36 my $is_notification = defined $procedure->jsonrpc && $procedure->jsonrpc eq '2.0' && !$procedure->has_id;
147 14         232 my $matched = $router->match( $procedure->{method} );
148 14 100       788 if (! $matched) {
149 3         11 my $message = "Procedure '$procedure->{method}' not found";
150 3         4 if (JSONRPC_DEBUG) {
151             warn $message;
152             }
153 3 100       9 if (!$is_notification) { # must not respond to a valid JSON-RPC notification
154 2         11 push @response, {
155             error => {
156             code => RPC_METHOD_NOT_FOUND,
157             message => $message,
158             }
159             };
160             }
161 3         8 next;
162             }
163              
164 11         18 my $action = $matched->{action};
165             try {
166 11     11   256 my ($ip, $ua);
167 11         14 if (JSONRPC_DEBUG > 1) {
168             warn "Procedure '$procedure->{method}' maps to action $action";
169             $ip = $req->address || 'N/A';
170             $ua = $req->user_agent || 'N/A';
171             }
172 11         33 my $params = $procedure->params;
173 11         63 my $handler = $self->get_handler( $matched->{handler} );
174              
175 11         40 my $code = $handler->can( $action );
176 11 50       29 if (! $code) {
177 0         0 if ( JSONRPC_DEBUG ) {
178             warn "[INFO] handler $handler does not implement method $action!.";
179             }
180 0         0 die "Internal Error";
181             }
182 11         26 my $result = $code->( $handler, $procedure->params, $procedure, @args );
183 4         72 if (JSONRPC_DEBUG) {
184             warn "[INFO] action=$action "
185             . "params=["
186             . (ref $params ? $self->{coder}->encode($params) : $params)
187             . "] ret="
188             . (ref $result ? $self->{coder}->encode($result) : $result)
189             . " IP=$ip UA=$ua";
190             }
191              
192             # respond unless we are sure a procedure is a notification
193 4 50       12 if (!$is_notification) {
194 4         17 push @response, {
195             jsonrpc => '2.0',
196             result => $result,
197             id => $procedure->id,
198             };
199             }
200             } catch {
201 7     7   125 my $e = $_;
202 7         8 if (JSONRPC_DEBUG) {
203             warn "Error while executing $action: $e";
204             }
205             # can't respond to notifications even in case of errors
206 7 100       48 if (!$is_notification) {
207 4         11 my $error = {code => RPC_INTERNAL_ERROR} ;
208 4 100       11 if (ref $e eq "HASH") {
209 1         5 $error->{message} = $e->{message},
210             $error->{data} = $e->{data},
211             } else {
212 3         6 $error->{message} = $e,
213             }
214 4         13 push @response, {
215             jsonrpc => '2.0',
216             id => $procedure->id,
217             error => $error,
218             };
219             }
220 11         111 };
221             }
222              
223 16         173 my $res;
224 16 100       33 if (scalar @response) {
225 14         61 $res = $req->new_response(200);
226 14         3572 $res->content_type( 'application/json; charset=utf8' );
227 14 100       344 $res->body(
228             $self->coder->encode( @$procedures > 1 ? \@response : $response[0] )
229             );
230 14         284 return $res->finalize;
231             } else { # no content
232 2         9 $res = $req->new_response(204);
233             }
234              
235 2         51 return $res->finalize;
236             }
237              
238 2     2   3142 no Try::Tiny;
  2         4  
  2         72  
239              
240             1;
241              
242             __END__