File Coverage

blib/lib/JSON/RPC/Dispatch.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


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