line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package RPC::ExtDirect::Router; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
1839
|
use strict; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
94
|
|
4
|
4
|
|
|
4
|
|
13
|
use warnings; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
88
|
|
5
|
4
|
|
|
4
|
|
18
|
no warnings 'uninitialized'; ## no critic |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
97
|
|
6
|
|
|
|
|
|
|
|
7
|
4
|
|
|
4
|
|
484
|
use RPC::ExtDirect::Util::Accessor; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
80
|
|
8
|
4
|
|
|
4
|
|
381
|
use RPC::ExtDirect::Config; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
72
|
|
9
|
4
|
|
|
4
|
|
725
|
use RPC::ExtDirect; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
16
|
|
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
|
126
|
my ($class, %arg) = @_; |
67
|
|
|
|
|
|
|
|
68
|
30
|
|
66
|
|
|
92
|
$arg{config} ||= RPC::ExtDirect::Config->new(); |
69
|
30
|
|
33
|
|
|
142
|
$arg{api} ||= RPC::ExtDirect->get_api(); |
70
|
|
|
|
|
|
|
|
71
|
30
|
|
|
|
|
132
|
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
|
8704
|
my ($class, $input, $env) = @_; |
89
|
|
|
|
|
|
|
|
90
|
30
|
100
|
|
|
|
73
|
my $self = ref($class) ? $class : $class->new(); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# Decode requests |
93
|
30
|
|
|
|
|
60
|
my ($has_upload, $requests) = $self->_decode_requests($input); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# Run requests and collect responses |
96
|
30
|
|
|
|
|
62
|
my $responses = $self->_run_requests($env, $requests); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# Serialize responses |
99
|
30
|
|
|
|
|
54
|
my $result = $self->_serialize_responses($responses); |
100
|
|
|
|
|
|
|
|
101
|
30
|
|
|
|
|
67
|
my $http_response = $self->_format_response($result, $has_upload); |
102
|
|
|
|
|
|
|
|
103
|
30
|
|
|
|
|
216
|
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
|
|
33
|
my ($self, $input) = @_; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# $input can be scalar containing POST data, |
126
|
|
|
|
|
|
|
# or a hashref containing form data |
127
|
30
|
|
|
|
|
40
|
my $has_form = ref $input eq 'HASH'; |
128
|
30
|
|
100
|
|
|
80
|
my $has_upload = $has_form && $input->{extUpload} eq 'true'; |
129
|
|
|
|
|
|
|
|
130
|
30
|
|
|
|
|
666
|
my $config = $self->config; |
131
|
30
|
|
|
|
|
852
|
my $api = $self->api; |
132
|
30
|
|
|
|
|
584
|
my $debug = $config->debug_router; |
133
|
|
|
|
|
|
|
|
134
|
30
|
|
|
|
|
591
|
my $deserializer_class = $config->deserializer_class_router; |
135
|
|
|
|
|
|
|
|
136
|
30
|
|
|
|
|
1449
|
eval "require $deserializer_class"; |
137
|
|
|
|
|
|
|
|
138
|
30
|
|
|
|
|
134
|
my $dser = $deserializer_class->new( config => $config, api => $api ); |
139
|
|
|
|
|
|
|
|
140
|
30
|
100
|
|
|
|
95
|
my $requests |
141
|
|
|
|
|
|
|
= $has_form ? $dser->decode_form(data => $input, debug => $debug) |
142
|
|
|
|
|
|
|
: $dser->decode_post(data => $input, debug => $debug) |
143
|
|
|
|
|
|
|
; |
144
|
|
|
|
|
|
|
|
145
|
30
|
|
|
|
|
100
|
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
|
|
32
|
my ($self, $env, $requests) = @_; |
155
|
|
|
|
|
|
|
|
156
|
30
|
|
|
|
|
30
|
my @responses; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# Run the requests, collect the responses |
159
|
30
|
|
|
|
|
48
|
for my $request ( @$requests ) { |
160
|
32
|
|
|
|
|
64
|
$request->run($env); |
161
|
32
|
|
|
|
|
77
|
push @responses, $request->result(); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
30
|
|
|
|
|
53
|
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
|
|
|
|
|
594
|
my $api = $self->api; |
176
|
30
|
|
|
|
|
572
|
my $config = $self->config; |
177
|
30
|
|
|
|
|
574
|
my $debug = $config->debug_router; |
178
|
|
|
|
|
|
|
|
179
|
30
|
|
|
|
|
572
|
my $serializer_class = $config->serializer_class_router; |
180
|
|
|
|
|
|
|
|
181
|
30
|
|
|
|
|
1385
|
eval "require $serializer_class"; |
182
|
|
|
|
|
|
|
|
183
|
30
|
|
|
|
|
126
|
my $serializer |
184
|
|
|
|
|
|
|
= $serializer_class->new( config => $config, api => $api ); |
185
|
|
|
|
|
|
|
|
186
|
30
|
|
|
|
|
68
|
my $result = $serializer->serialize( |
187
|
|
|
|
|
|
|
mute_exceptions => !1, |
188
|
|
|
|
|
|
|
debug => $debug, |
189
|
|
|
|
|
|
|
data => $responses, |
190
|
|
|
|
|
|
|
); |
191
|
|
|
|
|
|
|
|
192
|
30
|
|
|
|
|
66
|
return $result; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
196
|
|
|
|
|
|
|
# |
197
|
|
|
|
|
|
|
# Format Plack-compatible HTTP response |
198
|
|
|
|
|
|
|
# |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub _format_response { |
201
|
30
|
|
|
30
|
|
34
|
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
|
|
|
|
53
|
my $content_type = $has_upload ? 'text/html' : 'application/json'; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# We need content length in octets |
211
|
4
|
|
|
4
|
|
43
|
my $content_length = do { no warnings; use bytes; length $result }; |
|
4
|
|
|
4
|
|
5
|
|
|
4
|
|
|
|
|
113
|
|
|
4
|
|
|
|
|
2400
|
|
|
4
|
|
|
|
|
39
|
|
|
4
|
|
|
|
|
16
|
|
|
30
|
|
|
|
|
21
|
|
|
30
|
|
|
|
|
34
|
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
return [ |
214
|
30
|
|
|
|
|
93
|
200, |
215
|
|
|
|
|
|
|
[ |
216
|
|
|
|
|
|
|
'Content-Type', $content_type, |
217
|
|
|
|
|
|
|
'Content-Length', $content_length, |
218
|
|
|
|
|
|
|
], |
219
|
|
|
|
|
|
|
[ $result ], |
220
|
|
|
|
|
|
|
]; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
1; |