File Coverage

blib/lib/JSON/RPC/Spec.pm
Criterion Covered Total %
statement 75 77 97.4
branch 20 20 100.0
condition 2 2 100.0
subroutine 18 18 100.0
pod 3 3 100.0
total 118 120 98.3


line stmt bran cond sub pod time code
1             package JSON::RPC::Spec;
2 7     7   155479 use Moo;
  7         103164  
  7         37  
3 7     7   12086 use Carp ();
  7         16  
  7         126  
4 7     7   4946 use version; our $VERSION = version->declare("v1.0.5");
  7         14369  
  7         46  
5 7     7   1387 use Try::Tiny;
  7         1483  
  7         389  
6 7     7   5192 use Router::Simple;
  7         45901  
  7         226  
7 7     7   4355 use JSON::RPC::Spec::Procedure;
  7         24  
  7         225  
8 7     7   4256 use JSON::RPC::Spec::Client;
  7         18  
  7         357  
9             with qw(
10             JSON::RPC::Spec::Common
11             );
12              
13 7   100 7   41 use constant DEBUG => $ENV{PERL_JSON_RPC_SPEC_DEBUG} || 0;
  7         12  
  7         1178  
14              
15             has router => (
16             is => 'lazy',
17             isa => sub {
18             my $self = shift;
19             $self->can('match') or Carp::croak('method match required.');
20             },
21             );
22              
23             has _procedure => (is => 'lazy');
24              
25             has _client => (
26             is => 'lazy',
27             handles => [qw(compose)],
28             );
29              
30             has [qw(_is_batch _content)] => (is => 'rw');
31              
32 7     7   37 use namespace::clean;
  7         35  
  7         36  
33              
34              
35             sub _build_router {
36 5     5   2723 Router::Simple->new;
37             }
38              
39             sub _build__procedure {
40 6     6   2554 JSON::RPC::Spec::Procedure->new(router => shift->router);
41             }
42              
43             sub _build__client {
44 1     1   4144 JSON::RPC::Spec::Client->new;
45             }
46              
47             sub _parse_json {
48 47     47   75 my ($self, $extra_args) = @_;
49 47         48 warn qq{-- start parsing @{[$self->_content]}\n} if DEBUG;
  47         145  
50              
51 2 100       12 unless (length $self->_content) {
52 45         85 return $self->_rpc_invalid_request;
53             }
54              
55             # JSON decode
56             # rpc call with invalid JSON:
57             # rpc call Batch, invalid JSON:
58 45         306 my ($req, $err);
59             try {
60 3     45   218 $req = $self->coder->decode($self->_content);
61             }
62             catch {
63 3     3   12 $err = $_;
64 45         3253 warn qq{-- error : @{[$err]} } if DEBUG;
  3         19  
65 45         1291 };
66 42 100       115 if ($err) {
67 19         47 return $self->_rpc_parse_error;
68             }
69              
70             # Batch mode flag
71 23 100       58 if (ref $req eq 'ARRAY') {
72 23         50 $self->_is_batch(1);
73             }
74             else {
75 42         54 $self->_is_batch(0);
76 42         110 $req = [$req];
77             }
78              
79             # rpc call with an empty Array:
80 2 100       8 unless (scalar @{$req}) {
  40         52  
81 40         51 return $self->_rpc_invalid_request;
82             }
83              
84             # procedure call and create response
85 40         88 my @response;
86 48         956 for my $obj (@{$req}) {
  48         993  
87 40         121 my $res = $self->_procedure->parse($obj, $extra_args);
88              
89             # notification is ignore
90 34 100       152 push @response, $res if $res;
91             }
92 21 100       81 return unless @response;
93 0 100       0 return [@response] if $self->_is_batch;
94 0         0 return $response[0];
95             }
96              
97             # parse JSON string to hash
98             sub parse_without_encode {
99 19     19 1 20631 my $self = shift;
100 19         32 my $json_string = shift;
101 19         34 my $extra_args = +[@_];
102 19         64 $self->_content($json_string);
103 19         44 return $self->_parse_json($extra_args);
104             }
105              
106             # parse JSON string to JSON string
107             sub parse {
108 28     28 1 37135 my $self = shift;
109 28         51 my $json_string = shift;
110 28         53 my $extra_args = +[@_];
111 28         145 $self->_content($json_string);
112 28         65 my $result = $self->_parse_json($extra_args);
113 28 100       150 return unless $result;
114 25         75 return $self->coder->encode($result);
115             }
116              
117             # register method
118             sub register {
119 15     15 1 14084 my ($self, $pattern, $cb) = @_;
120 15 100       53 if (!defined $pattern) {
121 1         196 Carp::croak('pattern required');
122             }
123 14 100       48 if (ref $cb ne 'CODE') {
124 1         100 Carp::croak('code required');
125             }
126 13         241 $self->router->connect($pattern, +{$self->_callback_key => $cb}, +{});
127 13         1136 return $self;
128             }
129              
130             1;
131             __END__