File Coverage

blib/lib/RPC/ExtDirect/Router.pm
Criterion Covered Total %
statement 67 67 100.0
branch 8 8 100.0
condition 6 9 66.6
subroutine 14 14 100.0
pod 0 2 0.0
total 95 100 95.0


line stmt bran cond sub pod time code
1             package RPC::ExtDirect::Router;
2              
3 4     4   1595 use strict;
  4         4  
  4         87  
4 4     4   11 use warnings;
  4         4  
  4         78  
5 4     4   15 no warnings 'uninitialized'; ## no critic
  4         4  
  4         88  
6              
7 4     4   314 use RPC::ExtDirect::Util::Accessor;
  4         108  
  4         73  
8 4     4   334 use RPC::ExtDirect::Config;
  4         4  
  4         68  
9 4     4   976 use RPC::ExtDirect;
  4         3  
  4         13  
10              
11             ### PACKAGE GLOBAL VARIABLE ###
12             #
13             # Turn this on for debug output
14             #
15             # DEPRECATED. Use `debug_router` or `debug` Config options instead.
16             #
17              
18             our $DEBUG;
19              
20             ### PACKAGE GLOBAL VARIABLE ###
21             #
22             # Set Serializer class name so it could be configured
23             #
24             # DEPRECATED. Use `serializer_class_router` or `serializer_class`
25             # Config options instead.
26             #
27              
28             our $SERIALIZER_CLASS;
29              
30             ### PACKAGE GLOBAL VARIABLE ###
31             #
32             # Set Deserializer class name so it could be configured
33             #
34             # DEPRECATED. Use `deserializer_class_router` or `deserializer_class`
35             # Config options instead.
36             #
37              
38             our $DESERIALIZER_CLASS;
39              
40             ### PACKAGE GLOBAL VARIABLE ###
41             #
42             # Set Exception class name so it could be configured
43             #
44             # DEPRECATED. Use `exception_class_deserialize` or `exception_class`
45             # Config options instead.
46             #
47              
48             our $EXCEPTION_CLASS;
49              
50             ### PACKAGE GLOBAL VARIABLE ###
51             #
52             # Set Request class name so it could be configured
53             #
54             # DEPRECATED. Use `request_class_deserialize` or `request_class`
55             # Config options instead.
56             #
57              
58             our $REQUEST_CLASS;
59              
60             ### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
61             #
62             # Create a new Router object with default API and Config
63             #
64              
65             sub new {
66 30     30 0 95 my ($class, %arg) = @_;
67            
68 30   66     83 $arg{config} ||= RPC::ExtDirect::Config->new();
69 30   33     123 $arg{api} ||= RPC::ExtDirect->get_api();
70            
71 30         96 return bless { %arg }, $class;
72             }
73              
74             ### PUBLIC CLASS/INSTANCE METHOD ###
75             #
76             # Route the request(s) and return serialized responses
77             #
78             # Note that the preferred way to call this method is on the Router
79             # object instance, but we support the class-based way for backwards
80             # compatibility.
81             #
82             # Be aware that the only supported way to configure the Router
83             # is to pass a Config object to the constructor and then call route()
84             # on the instance.
85             #
86              
87             sub route {
88 30     30 0 8855 my ($class, $input, $env) = @_;
89            
90 30 100       53 my $self = ref($class) ? $class : $class->new();
91            
92             # Decode requests
93 30         52 my ($has_upload, $requests) = $self->_decode_requests($input);
94              
95             # Run requests and collect responses
96 30         54 my $responses = $self->_run_requests($env, $requests);
97              
98             # Serialize responses
99 30         49 my $result = $self->_serialize_responses($responses);
100              
101 30         50 my $http_response = $self->_format_response($result, $has_upload);
102            
103 30         190 return $http_response;
104             }
105              
106             ### PUBLIC INSTANCE METHODS ###
107             #
108             # Read-write accessors.
109             #
110              
111             RPC::ExtDirect::Util::Accessor::mk_accessors(
112             simple => [qw/ api config /],
113             );
114              
115             ############## PRIVATE METHODS BELOW ##############
116              
117             ### PRIVATE INSTANCE METHOD ###
118             #
119             # Decode requests
120             #
121              
122             sub _decode_requests {
123 30     30   27 my ($self, $input) = @_;
124            
125             # $input can be scalar containing POST data,
126             # or a hashref containing form data
127 30         35 my $has_form = ref $input eq 'HASH';
128 30   100     66 my $has_upload = $has_form && $input->{extUpload} eq 'true';
129            
130 30         546 my $config = $self->config;
131 30         491 my $api = $self->api;
132 30         484 my $debug = $config->debug_router;
133            
134 30         503 my $deserializer_class = $config->deserializer_class_router;
135            
136 30         1278 eval "require $deserializer_class";
137            
138 30         110 my $dser = $deserializer_class->new( config => $config, api => $api );
139              
140 30 100       82 my $requests
141             = $has_form ? $dser->decode_form(data => $input, debug => $debug)
142             : $dser->decode_post(data => $input, debug => $debug)
143             ;
144            
145 30         88 return ($has_upload, $requests);
146             }
147              
148             ### PRIVATE INSTANCE METHOD ###
149             #
150             # Run the requests and return their results
151             #
152              
153             sub _run_requests {
154 30     30   26 my ($self, $env, $requests) = @_;
155              
156 30         26 my @responses;
157            
158             # Run the requests, collect the responses
159 30         43 for my $request ( @$requests ) {
160 32         63 $request->run($env);
161 32         57 push @responses, $request->result();
162             }
163              
164 30         41 return \@responses;
165             }
166              
167             ### PRIVATE INSTANCE METHOD ###
168             #
169             # Serialize the responses and return result
170             #
171              
172             sub _serialize_responses {
173 30     30   28 my ($self, $responses) = @_;
174            
175 30         521 my $api = $self->api;
176 30         490 my $config = $self->config;
177 30         488 my $debug = $config->debug_router;
178            
179 30         536 my $serializer_class = $config->serializer_class_router;
180            
181 30         1238 eval "require $serializer_class";
182            
183 30         116 my $serializer
184             = $serializer_class->new( config => $config, api => $api );
185              
186 30         70 my $result = $serializer->serialize(
187             mute_exceptions => !1,
188             debug => $debug,
189             data => $responses,
190             );
191            
192 30         79 return $result;
193             }
194              
195             ### PRIVATE INSTANCE METHOD ###
196             #
197             # Format Plack-compatible HTTP response
198             #
199              
200             sub _format_response {
201 30     30   37 my ($self, $result, $has_upload) = @_;
202            
203             # Wrap in HTML if that was form upload request
204 30 100       57 $result = ""
205             if $has_upload;
206              
207             # Form upload responses are JSON wrapped in HTML, not plain JSON
208 30 100       42 my $content_type = $has_upload ? 'text/html' : 'application/json';
209              
210             # We need content length in octets
211 4     4   17 my $content_length = do { no warnings; use bytes; length $result };
  4     4   6  
  4         96  
  4         2061  
  4         30  
  4         15  
  30         23  
  30         32  
212              
213             return [
214 30         75 200,
215             [
216             'Content-Type', $content_type,
217             'Content-Length', $content_length,
218             ],
219             [ $result ],
220             ];
221             }
222              
223             1;