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