File Coverage

blib/lib/Catalyst/Plugin/JSONRPC.pm
Criterion Covered Total %
statement 38 44 86.4
branch 6 16 37.5
condition 6 17 35.3
subroutine 3 3 100.0
pod 1 1 100.0
total 54 81 66.7


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::JSONRPC;
2              
3 2     2   34 use strict;
  2         103  
  2         206  
4             our $VERSION = '0.01';
5              
6 2     2   396 use JSON ();
  2         20  
  2         20  
7              
8             sub json_rpc {
9 2     2 1 113     my $c = shift;
10 2 50       25     my $attrs = @_ > 1 ? {@_} : $_[0];
11              
12 2         23     my $body = $c->req->body;
13 2         274     my $content = do { local $/; <$body> };
  2         24  
  2         194  
14              
15 2         27     my $req;
16 2         22     eval { $req = JSON::jsonToObj($content) };
  2         30  
17 2 50 33     2099     if ($@ || !$req) {
18 0         0         $c->log->debug(qq/Invalid JSON-RPC request: "$@"/);
19 0         0         $c->res->content_type('text/javascript+json');
20 0         0         $c->res->body(JSON::objToJson({
21                         result => undef,
22                         error => 'Invalid request',
23                     }));
24 0         0         return 0;
25                 }
26              
27 2         20     my $res = 0;
28              
29 2   33     31     my $method = $attrs->{method} || $req->{method};
30 2 50       75     if ($method) {
31 2   33     33         my $class = $attrs->{class} || caller(0);
32 2 50       41         if (my $code = $class->can($method)) {
33              
34 2         18             my $remote;
35 2   50     27             my $attrs = attributes::get($code) || [];
36 2         297             for my $attr (@$attrs) {
37 2 50       30                 $remote++ if $attr eq 'Remote';
38                         }
39              
40 2 50       22             if ($remote) {
41 2   33     25                 $class = $c->components->{$class} || $class;
42 2         49                 my @args = @{ $c->req->args };
  2         26  
43 2         55                 $c->req->args( $req->{params} );
44 2   33     24                 my $name = ref $class || $class;
45 2         32                 my $action = Catalyst::Action->new(
46                                 {
47                                     name => $method,
48                                     code => $code,
49                                     reverse => "-> $name->$method",
50                                     class => $name,
51                                     namespace => Catalyst::Utils::class2prefix(
52                                         $name, $c->config->{case_sensitive}
53                                     ),
54                                 }
55                             );
56 2         684                 $c->state( $c->execute( $class, $action ) );
57 2         27                 $res = $c->state;
58 2         42                 $c->req->args( \@args );
59                         }
60                         else {
61 0 0       0                 $c->log->debug(qq/Method "$method" has no Remote attribute/)
62                               if $c->debug;
63                         }
64                     }
65                     else {
66 0 0       0             $c->log->debug(qq/Couldn't find JSON-RPC method "$method"/)
67                           if $c->debug;
68                     }
69              
70                 }
71              
72 2         24     $c->res->content_type('text/javascript+json');
73 2         249     $c->res->body(JSON::objToJson({
74                     result => $res,
75                     error => undef,
76                     id => $req->{id},
77                 }));
78              
79 2         1208     return $res;
80             }
81              
82             1;
83             __END__
84            
85             =head1 NAME
86            
87             Catalyst::Plugin::JSONRPC - Dispatch JSON-RPC methods with Catalyst
88            
89             =head1 SYNOPSIS
90            
91             # include it in plugin list
92             use Catalyst qw/JSONRPC/;
93            
94             # Public action to redispatch
95             sub entrypoint : Global {
96             my ( $self, $c ) = @_;
97             $c->json_rpc;
98             }
99            
100             # Methods with Remote attribute in the same class
101             sub echo : Remote {
102             my ( $self, $c, @args ) = @_;
103             return join ' ', @args;
104             }
105            
106             =head1 DESCRIPTION
107            
108             Catalyst::Plugin::JSONRPC is a Catalyst plugin to add JSON-RPC methods
109             in your controller class. It uses a same mechanism that XMLRPC plugin
110             does and actually plays really nicely.
111            
112             =head2 METHODS
113            
114             =over 4
115            
116             =item $c->json_rpc(%attrs)
117            
118             Call this method from a controller action to set it up as a endpoint
119             for RPC methods in the same class.
120            
121             Supported attributes:
122            
123             =over 8
124            
125             =item class
126            
127             name of class to dispatch (defaults to current one)
128            
129             =item method
130            
131             method to dispatch to (overrides JSON-RPC method name)
132            
133             =back
134            
135             =back
136            
137             =head2 REMOTE ACTION ATTRIBUTE
138            
139             This module uses C<Remote> attribute, which indicates that the action
140             can be dispatched through RPC mechanisms. You can use this C<Remote>
141             attribute and integrate JSON-RPC and XML-RPC together, for example:
142            
143             sub xmlrpc_endpoint : Regexp('^xml-rpc$') {
144             my($self, $c) = @_;
145             $c->xmlrpc;
146             }
147            
148             sub jsonrpc_endpoint : Regexp('^json-rpc$') {
149             my($self, $c) = @_;
150             $c->json_rpc;
151             }
152            
153             sub add : Remote {
154             my($self, $c, $a, $b) = @_;
155             return $a + $b;
156             }
157            
158             Now C<add> RPC method can be called either as JSON-RPC or
159             XML-RPC.
160            
161             =head1 AUTHOR & LICENSE
162            
163             Six Apart, Ltd. E<lt>cpan@sixapart.comE<gt>
164            
165             This library is free software; you can redistribute it and/or modify
166             it under the same terms as Perl itself.
167            
168             =head1 THANKS
169            
170             Thanks to Sebastian Riedel for his L<Catalyst::Plugin::XMLRPC>, from
171             which a lot of code is copied.
172            
173             =head1 SEE ALSO
174            
175             L<Catalyst::Plugin::XMLRPC>, C<JSON>, C<JSONRPC>
176            
177             =cut
178