File Coverage

blib/lib/JSON/RPC2/Server.pm
Criterion Covered Total %
statement 125 126 99.2
branch 51 52 98.0
condition 12 12 100.0
subroutine 23 23 100.0
pod 6 6 100.0
total 217 219 99.0


line stmt bran cond sub pod time code
1             package JSON::RPC2::Server;
2 14     14   124402 use 5.010001;
  14         66  
3 14     14   61 use warnings;
  14         23  
  14         341  
4 14     14   61 use strict;
  14         26  
  14         249  
5 14     14   1088 use utf8;
  14         52  
  14         69  
6 14     14   326 use Carp;
  14         32  
  14         996  
7              
8             our $VERSION = 'v2.1.2';
9              
10 14     14   877 use JSON::MaybeXS;
  14         13044  
  14         806  
11              
12 14     14   79 use constant ERR_PARSE => -32700;
  14         21  
  14         987  
13 14     14   73 use constant ERR_REQ => -32600;
  14         23  
  14         678  
14 14     14   66 use constant ERR_METHOD => -32601;
  14         21  
  14         610  
15 14     14   73 use constant ERR_PARAMS => -32602;
  14         30  
  14         14704  
16              
17              
18             sub new {
19 5     5 1 403 my ($class) = @_;
20 5         20 my $self = {
21             method => {},
22             };
23 5         15 return bless $self, $class;
24             }
25              
26             sub register {
27 11     11 1 1364 my ($self, $name, $cb) = @_;
28 11         36 $self->{method}{ $name } = [ $cb, 1, 0 ];
29 11         21 return;
30             }
31              
32             sub register_named {
33 6     6 1 35 my ($self, $name, $cb) = @_;
34 6         20 $self->{method}{ $name } = [ $cb, 1, 1 ];
35 6         12 return;
36             }
37              
38             sub register_nb {
39 5     5 1 24 my ($self, $name, $cb) = @_;
40 5         9 $self->{method}{ $name } = [ $cb, 0, 0 ];
41 5         8 return;
42             }
43              
44             sub register_named_nb {
45 5     5 1 20 my ($self, $name, $cb) = @_;
46 5         9 $self->{method}{ $name } = [ $cb, 0, 1 ];
47 5         10 return;
48             }
49              
50             sub execute {
51 75     75 1 47308 my ($self, $json, $cb) = @_;
52 75 100       236 croak 'require 2 params' if 1+2 != @_;
53 72 100       207 croak 'second param must be callback' if ref $cb ne 'CODE';
54              
55 68         107 undef $@;
56 68 100       146 my $request = ref $json ? $json : eval { decode_json($json) };
  64         425  
57 68 100       160 if ($@) {
58 7         20 return _error($cb, undef, ERR_PARSE, 'Parse error.');
59             }
60 61 100       166 if (ref $request eq 'HASH') {
61 54         129 return $self->_execute($request, $cb);
62             }
63 7 50       20 if (ref $request ne 'ARRAY') {
64 0         0 return _error($cb, undef, ERR_REQ, 'Invalid Request: expect Array or Object.');
65             }
66 7 100       19 if (!@{$request}) {
  7         20  
67 2         6 return _error($cb, undef, ERR_REQ, 'Invalid Request: empty Array.');
68             }
69              
70 5         7 my $pending = @{$request};
  5         7  
71 5         7 my @responses;
72             my $cb_acc = sub {
73 21     21   43 my ($json_response) = @_;
74 21 100       42 if ($json_response) {
75 13         21 push @responses, $json_response;
76             }
77 21 100       46 if (!--$pending) {
78 5 100       10 if (@responses) {
79 4         35 $cb->( '[' . join(q{,}, @responses) . ']' );
80             } else {
81 1         3 $cb->( q{} );
82             }
83             }
84 21         135 return;
85 5         21 };
86 5         8 for (@{$request}) {
  5         10  
87 21         35 $self->_execute($_, $cb_acc);
88             }
89              
90 5         37 return;
91             }
92              
93             sub _execute {
94 75     75   181 my ($self, $request, $cb) = @_;
95              
96 75         120 my $error = \&_error;
97 75         410 my $done = \&_done;
98              
99             # jsonrpc =>
100 75 100 100     409 if (!defined $request->{jsonrpc} || ref $request->{jsonrpc} || $request->{jsonrpc} ne '2.0') {
      100        
101 13         28 return $error->($cb, undef, ERR_REQ, 'Invalid Request: expect {jsonrpc}="2.0".');
102             }
103              
104             # id =>
105 62         86 my $id;
106 62 100       105 if (exists $request->{id}) {
107             # Request
108 48 100       89 if (ref $request->{id}) {
109 4         10 return $error->($cb, undef, ERR_REQ, 'Invalid Request: expect {id} is scalar.');
110             }
111 44         77 $id = $request->{id};
112             }
113              
114             # method =>
115 58 100 100     173 if (!defined $request->{method} || ref $request->{method}) {
116 5         10 return $error->($cb, $id, ERR_REQ, 'Invalid Request: expect {method} is String.');
117             }
118 53         116 my $handler = $self->{method}{ $request->{method} };
119 53 100       94 if (!$handler) {
120 3         7 return $error->($cb, $id, ERR_METHOD, 'Method not found.');
121             }
122 50         56 my ($method, $is_blocking, $is_named) = @{$handler};
  50         88  
123              
124             # params =>
125 50 100       94 if (!exists $request->{params}) {
126 2 100       7 $request->{params} = $is_named ? {} : [];
127             }
128 50 100 100     154 if (ref $request->{params} ne 'ARRAY' && ref $request->{params} ne 'HASH') {
129 5         9 return $error->($cb, $id, ERR_REQ, 'Invalid Request: expect {params} is Array or Object.');
130             }
131 45 100       97 if (ref $request->{params} ne ($is_named ? 'HASH' : 'ARRAY')) {
    100          
132 15 100       52 return $error->($cb, $id, ERR_PARAMS, 'This method expect '.($is_named ? 'named' : 'positional').' params.');
133             }
134 30 100       46 my @params = $is_named ? %{ $request->{params} } : @{ $request->{params} };
  13         34  
  17         37  
135              
136             # id => (continue)
137 30 100       58 if (!exists $request->{id}) {
138             # Notification
139 10         20 $error = \&_nothing;
140 10         13 $done = \&_nothing;
141             }
142              
143             # execute
144 30 100       48 if ($is_blocking) {
145 21         51 my @returns = $method->( @params );
146 21         125 $done->($cb, $id, \@returns);
147             }
148             else {
149 9     9   23 my $cb_done = sub { $done->($cb, $id, \@_) };
  9         40200  
150 9         34 $method->( $cb_done, @params );
151             }
152 30         166 return;
153             }
154              
155             sub _done {
156 20     20   45 my ($cb, $id, $returns) = @_;
157 20         31 my ($result, $code, $msg, $data) = @{$returns};
  20         47  
158 20 100       55 if (defined $code) {
159 9         34 return _error($cb, $id, $code, $msg, $data);
160             }
161 11         28 return _result($cb, $id, $result);
162             }
163              
164             sub _error {
165 63     63   136 my ($cb, $id, $code, $message, $data) = @_;
166 63 100       615 $cb->( encode_json({
167             jsonrpc => '2.0',
168             id => $id,
169             error => {
170             code => $code,
171             message => $message,
172             (defined $data ? ( data => $data ) : ()),
173             },
174             }) );
175 63         518 return;
176             }
177              
178             sub _result {
179 11     11   24 my ($cb, $id, $result) = @_;
180 11         93 $cb->( encode_json({
181             jsonrpc => '2.0',
182             id => $id,
183             result => $result,
184             }) );
185 11         67 return;
186             }
187              
188             sub _nothing {
189 10     10   20 my ($cb) = @_;
190 10         22 $cb->( q{} );
191 10         25 return;
192             }
193              
194              
195             1; # Magic true value required at end of module
196             __END__