line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Plack::Middleware::ExtDirect; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
397524
|
use parent 'Plack::Middleware'; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
21
|
|
4
|
|
|
|
|
|
|
|
5
|
4
|
|
|
4
|
|
203
|
use strict; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
77
|
|
6
|
4
|
|
|
4
|
|
10
|
use warnings; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
66
|
|
7
|
4
|
|
|
4
|
|
12
|
no warnings 'uninitialized'; ## no critic |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
86
|
|
8
|
|
|
|
|
|
|
|
9
|
4
|
|
|
4
|
|
12
|
use Carp; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
169
|
|
10
|
4
|
|
|
4
|
|
1626
|
use IO::File; |
|
4
|
|
|
|
|
5513
|
|
|
4
|
|
|
|
|
360
|
|
11
|
|
|
|
|
|
|
|
12
|
4
|
|
|
4
|
|
1571
|
use Plack::Request; |
|
4
|
|
|
|
|
89030
|
|
|
4
|
|
|
|
|
102
|
|
13
|
4
|
|
|
4
|
|
22
|
use Plack::Util; |
|
4
|
|
|
|
|
3
|
|
|
4
|
|
|
|
|
63
|
|
14
|
|
|
|
|
|
|
|
15
|
4
|
|
|
4
|
|
14
|
use RPC::ExtDirect::Util (); |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
37
|
|
16
|
4
|
|
|
4
|
|
32
|
use RPC::ExtDirect::Util::Accessor; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
61
|
|
17
|
4
|
|
|
4
|
|
11
|
use RPC::ExtDirect::Config; |
|
4
|
|
|
|
|
3
|
|
|
4
|
|
|
|
|
61
|
|
18
|
4
|
|
|
4
|
|
10
|
use RPC::ExtDirect::API; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
24
|
|
19
|
4
|
|
|
4
|
|
61
|
use RPC::ExtDirect; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
16
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# |
22
|
|
|
|
|
|
|
# This module is not compatible with RPC::ExtDirect < 3.0 |
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
croak __PACKAGE__." requires RPC::ExtDirect 3.0+" |
26
|
|
|
|
|
|
|
if $RPC::ExtDirect::VERSION lt '3.0'; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
### PACKAGE GLOBAL VARIABLE ### |
29
|
|
|
|
|
|
|
# |
30
|
|
|
|
|
|
|
# Version of the module |
31
|
|
|
|
|
|
|
# |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
our $VERSION = '3.20'; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD (CONSTRUCTOR) ### |
36
|
|
|
|
|
|
|
# |
37
|
|
|
|
|
|
|
# Instantiates a new Plack::Middleware::ExtDirect object |
38
|
|
|
|
|
|
|
# |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub new { |
41
|
35
|
|
|
35
|
1
|
100353
|
my $class = shift; |
42
|
|
|
|
|
|
|
|
43
|
35
|
50
|
33
|
|
|
217
|
my %params = @_ == 1 && 'HASH' eq ref($_[0]) ? %{ $_[0] } : @_; |
|
35
|
|
|
|
|
125
|
|
44
|
|
|
|
|
|
|
|
45
|
35
|
|
33
|
|
|
256
|
my $api = delete $params{api} || RPC::ExtDirect->get_api(); |
46
|
35
|
|
33
|
|
|
1013
|
my $config = delete $params{config} || $api->config; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# These two are not method calls, they need to do their stuff *before* |
49
|
|
|
|
|
|
|
# we have found $self |
50
|
35
|
|
|
|
|
253
|
_decorate_config($config); |
51
|
35
|
|
|
|
|
12307
|
_process_params($api, $config, \%params); |
52
|
|
|
|
|
|
|
|
53
|
35
|
|
|
|
|
148
|
my $self = $class->SUPER::new(%params); |
54
|
|
|
|
|
|
|
|
55
|
35
|
|
|
|
|
821
|
$self->config($config); |
56
|
35
|
|
|
|
|
1054
|
$self->api($api); |
57
|
|
|
|
|
|
|
|
58
|
35
|
|
|
|
|
208
|
return $self; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
62
|
|
|
|
|
|
|
# |
63
|
|
|
|
|
|
|
# Dispatch calls to Ext.Direct handlers |
64
|
|
|
|
|
|
|
# |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub call { |
67
|
35
|
|
|
35
|
1
|
57664
|
my ($self, $env) = @_; |
68
|
|
|
|
|
|
|
|
69
|
35
|
|
|
|
|
747
|
my $config = $self->config; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# Run the relevant handler. Router calls are the most frequent |
72
|
|
|
|
|
|
|
# so we test for them first |
73
|
35
|
|
|
|
|
197
|
for ( $env->{PATH_INFO} ) { |
74
|
35
|
100
|
|
|
|
569
|
return $self->_handle_router($env) if $_ =~ $config->router_path; |
75
|
8
|
100
|
|
|
|
206
|
return $self->_handle_events($env) if $_ =~ $config->poll_path; |
76
|
3
|
50
|
|
|
|
70
|
return $self->_handle_api($env) if $_ =~ $config->api_path; |
77
|
|
|
|
|
|
|
}; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Not our URI, fall through |
80
|
0
|
|
|
|
|
0
|
return $self->app->($env); |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHODS ### |
84
|
|
|
|
|
|
|
# |
85
|
|
|
|
|
|
|
# Read-write accessors |
86
|
|
|
|
|
|
|
# |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
RPC::ExtDirect::Util::Accessor->mk_accessors( |
89
|
|
|
|
|
|
|
simple => [qw/ api config /], |
90
|
|
|
|
|
|
|
); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
############## PRIVATE METHODS BELOW ############## |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
### PRIVATE PACKAGE SUBROUTINE ### |
95
|
|
|
|
|
|
|
# |
96
|
|
|
|
|
|
|
# Decorate a Config object with __PACKAGE__-specific accessors |
97
|
|
|
|
|
|
|
# |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub _decorate_config { |
100
|
35
|
|
|
35
|
|
51
|
my ($config) = @_; |
101
|
|
|
|
|
|
|
|
102
|
35
|
|
|
|
|
238
|
$config->add_accessors( |
103
|
|
|
|
|
|
|
overwrite => 1, |
104
|
|
|
|
|
|
|
complex => [{ |
105
|
|
|
|
|
|
|
accessor => 'router_class_plack', |
106
|
|
|
|
|
|
|
fallback => 'router_class', |
107
|
|
|
|
|
|
|
}, { |
108
|
|
|
|
|
|
|
accessor => 'eventprovider_class_plack', |
109
|
|
|
|
|
|
|
fallback => 'eventprovider_class', |
110
|
|
|
|
|
|
|
}], |
111
|
|
|
|
|
|
|
); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
### PRIVATE PACKAGE SUBROUTINE ### |
115
|
|
|
|
|
|
|
# |
116
|
|
|
|
|
|
|
# Process parameters directly passed to the constructor |
117
|
|
|
|
|
|
|
# and set the Config/API options accordingly |
118
|
|
|
|
|
|
|
# |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub _process_params { |
121
|
35
|
|
|
35
|
|
54
|
my ($api, $config, $params) = @_; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# We used to accept these parameters directly in the constructor; |
124
|
|
|
|
|
|
|
# this behavior is not recommended now but it doesn't make much sense |
125
|
|
|
|
|
|
|
# to deprecate it either |
126
|
35
|
|
|
|
|
106
|
my @compat_params = qw/ |
127
|
|
|
|
|
|
|
api_path router_path poll_path namespace remoting_var polling_var |
128
|
|
|
|
|
|
|
auto_connect debug no_polling |
129
|
|
|
|
|
|
|
/; |
130
|
|
|
|
|
|
|
|
131
|
35
|
|
|
|
|
47
|
for my $var ( @compat_params ) { |
132
|
315
|
100
|
|
|
|
3793
|
$config->$var( delete $params->{$var} ) if exists $params->{$var}; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
35
|
50
|
|
|
|
96
|
$config->router_class_plack( delete $params->{router} ) |
136
|
|
|
|
|
|
|
if exists $params->{router}; |
137
|
|
|
|
|
|
|
|
138
|
35
|
50
|
|
|
|
74
|
$config->eventprovider_class_plack( delete $params->{event_provider} ) |
139
|
|
|
|
|
|
|
if exists $params->{event_provider}; |
140
|
|
|
|
|
|
|
|
141
|
35
|
|
|
|
|
114
|
for my $type ( $api->HOOK_TYPES ) { |
142
|
105
|
50
|
|
|
|
241
|
my $code = delete $params->{ $type } if exists $params->{ $type }; |
143
|
|
|
|
|
|
|
|
144
|
105
|
50
|
|
|
|
186
|
$api->add_hook( type => $type, code => $code ) if defined $code; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
149
|
|
|
|
|
|
|
# |
150
|
|
|
|
|
|
|
# Handles Ext.Direct API calls |
151
|
|
|
|
|
|
|
# |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub _handle_api { |
154
|
3
|
|
|
3
|
|
26
|
my ($self, $env) = @_; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# Get the API JavaScript chunk |
157
|
3
|
|
|
|
|
3
|
my $js = eval { |
158
|
3
|
|
|
|
|
46
|
$self->api->get_remoting_api( config => $self->config ) |
159
|
|
|
|
|
|
|
}; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# If JS API call failed, return error |
162
|
3
|
50
|
|
|
|
11865
|
return $self->_error_response if $@; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# We need content length, in octets |
165
|
4
|
|
|
4
|
|
1543
|
my $content_length = do { use bytes; my $len = length $js }; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
15
|
|
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
6
|
|
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
return [ |
168
|
3
|
|
|
|
|
27
|
200, |
169
|
|
|
|
|
|
|
[ |
170
|
|
|
|
|
|
|
'Content-Type' => 'application/javascript', |
171
|
|
|
|
|
|
|
'Content-Length' => $content_length, |
172
|
|
|
|
|
|
|
], |
173
|
|
|
|
|
|
|
[ $js ], |
174
|
|
|
|
|
|
|
]; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
178
|
|
|
|
|
|
|
# |
179
|
|
|
|
|
|
|
# Dispatches Ext.Direct method requests |
180
|
|
|
|
|
|
|
# |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub _handle_router { |
183
|
27
|
|
|
27
|
|
228
|
my ($self, $env) = @_; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# Throw an error if any method but POST is used |
186
|
27
|
50
|
|
|
|
65
|
return $self->_error_response |
187
|
|
|
|
|
|
|
unless $env->{REQUEST_METHOD} eq 'POST'; |
188
|
|
|
|
|
|
|
|
189
|
27
|
|
|
|
|
403
|
my $config = $self->config; |
190
|
27
|
|
|
|
|
464
|
my $api = $self->api; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# Now we need a Request object |
193
|
27
|
|
|
|
|
194
|
my $req = Plack::Request->new($env); |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# Try to distinguish between raw POST and form call |
196
|
27
|
|
|
|
|
206
|
my $router_input = $self->_extract_post_data($req); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# When extraction fails, undef is returned by method above |
199
|
27
|
50
|
|
|
|
52
|
return $self->_error_response unless defined $router_input; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# Rebless request as our environment object for compatibility |
202
|
27
|
|
|
|
|
79
|
bless $req, __PACKAGE__.'::Env'; |
203
|
|
|
|
|
|
|
|
204
|
27
|
|
|
|
|
613
|
my $router_class = $config->router_class_plack; |
205
|
|
|
|
|
|
|
|
206
|
27
|
|
|
|
|
1804
|
eval "require $router_class"; |
207
|
|
|
|
|
|
|
|
208
|
27
|
|
|
|
|
2019
|
my $router = $router_class->new( |
209
|
|
|
|
|
|
|
config => $config, |
210
|
|
|
|
|
|
|
api => $api, |
211
|
|
|
|
|
|
|
); |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# Routing requests is safe (Router won't croak under torture) |
214
|
27
|
|
|
|
|
324
|
my $result = $router->route($router_input, $req); |
215
|
|
|
|
|
|
|
|
216
|
27
|
|
|
|
|
45557
|
return $result; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
220
|
|
|
|
|
|
|
# |
221
|
|
|
|
|
|
|
# Polls Event handlers for events, returning serialized stream |
222
|
|
|
|
|
|
|
# |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub _handle_events { |
225
|
5
|
|
|
5
|
|
40
|
my ($self, $env) = @_; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# Only GET and POST methods are supported for polling |
228
|
5
|
50
|
|
|
|
21
|
return $self->_error_response |
229
|
|
|
|
|
|
|
if $env->{REQUEST_METHOD} !~ / \A (GET|POST) \z /xms; |
230
|
|
|
|
|
|
|
|
231
|
5
|
|
|
|
|
32
|
my $req = Plack::Middleware::ExtDirect::Env->new($env); |
232
|
|
|
|
|
|
|
|
233
|
5
|
|
|
|
|
104
|
my $config = $self->config; |
234
|
5
|
|
|
|
|
88
|
my $api = $self->api; |
235
|
|
|
|
|
|
|
|
236
|
5
|
|
|
|
|
90
|
my $provider_class = $config->eventprovider_class_plack; |
237
|
|
|
|
|
|
|
|
238
|
5
|
|
|
|
|
299
|
eval "require $provider_class"; |
239
|
|
|
|
|
|
|
|
240
|
5
|
|
|
|
|
1440
|
my $provider = $provider_class->new( |
241
|
|
|
|
|
|
|
config => $config, |
242
|
|
|
|
|
|
|
api => $api, |
243
|
|
|
|
|
|
|
); |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# Polling for Events is safe |
246
|
5
|
|
|
|
|
48
|
my $http_body = $provider->poll($req); |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
# We need content length, in octets |
249
|
|
|
|
|
|
|
my $content_length |
250
|
4
|
|
|
4
|
|
993
|
= do { no warnings 'void'; use bytes; length $http_body }; |
|
4
|
|
|
4
|
|
4
|
|
|
4
|
|
|
|
|
110
|
|
|
4
|
|
|
|
|
12
|
|
|
4
|
|
|
|
|
3
|
|
|
4
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
11007
|
|
|
5
|
|
|
|
|
9
|
|
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
return [ |
253
|
5
|
|
|
|
|
50
|
200, |
254
|
|
|
|
|
|
|
[ |
255
|
|
|
|
|
|
|
'Content-Type' => 'application/json; charset=utf-8', |
256
|
|
|
|
|
|
|
'Content-Length' => $content_length, |
257
|
|
|
|
|
|
|
], |
258
|
|
|
|
|
|
|
[ $http_body ], |
259
|
|
|
|
|
|
|
]; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
263
|
|
|
|
|
|
|
# |
264
|
|
|
|
|
|
|
# Deals with intricacies of POST-fu and returns something suitable to |
265
|
|
|
|
|
|
|
# feed to Router (string or hashref, really). Or undef if something |
266
|
|
|
|
|
|
|
# goes too wrong to recover. |
267
|
|
|
|
|
|
|
# |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
sub _extract_post_data { |
270
|
27
|
|
|
27
|
|
35
|
my ($self, $req) = @_; |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# The smartest way to tell if a form was submitted that *I* know of |
273
|
|
|
|
|
|
|
# is to look for 'extAction' and 'extMethod' keywords in form params. |
274
|
27
|
|
66
|
|
|
66
|
my $is_form = $req->param('extAction') && $req->param('extMethod'); |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# If form is not involved, it's easy: just return raw POST (or undef) |
277
|
27
|
100
|
|
|
|
21947
|
if ( !$is_form ) { |
278
|
21
|
|
|
|
|
47
|
my $postdata = $req->content; |
279
|
21
|
50
|
|
|
|
509
|
return $postdata ne '' ? $postdata |
280
|
|
|
|
|
|
|
: undef |
281
|
|
|
|
|
|
|
; |
282
|
|
|
|
|
|
|
}; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# If any files are attached, extUpload field will be set to 'true' |
285
|
6
|
|
|
|
|
13
|
my $has_uploads = $req->param('extUpload') eq 'true'; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# Outgoing hash |
288
|
6
|
|
|
|
|
39
|
my %keyword; |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# Pluck all parameters from Plack::Request |
291
|
6
|
|
|
|
|
10
|
for my $param ( $req->param ) { |
292
|
52
|
|
|
|
|
111
|
my @values = $req->param($param); |
293
|
52
|
50
|
|
|
|
763
|
$keyword{ $param } = @values == 0 ? undef |
|
|
50
|
|
|
|
|
|
294
|
|
|
|
|
|
|
: @values == 1 ? $values[0] |
295
|
|
|
|
|
|
|
: [ @values ] |
296
|
|
|
|
|
|
|
; |
297
|
|
|
|
|
|
|
}; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
# Find all file uploads |
300
|
6
|
100
|
|
|
|
15
|
if ( $has_uploads ) { |
301
|
3
|
|
|
|
|
7
|
my $uploads = $req->uploads; # Hash::MultiValue |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# We need files as plain list (keys %$uploads is by design) |
304
|
|
|
|
|
|
|
my @field_uploads |
305
|
3
|
|
|
|
|
23
|
= map { $self->_format_uploads( $uploads->get_all($_) ) } |
|
2
|
|
|
|
|
4
|
|
306
|
|
|
|
|
|
|
keys %$uploads; |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
# Now remove fields that contained files |
309
|
3
|
|
|
|
|
10
|
delete @keyword{ $uploads->keys }; |
310
|
|
|
|
|
|
|
|
311
|
3
|
100
|
|
|
|
23
|
$keyword{ '_uploads' } = \@field_uploads if @field_uploads; |
312
|
|
|
|
|
|
|
}; |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
# Metadata is JSON encoded; decode_metadata lives by side effects! |
315
|
6
|
100
|
|
|
|
16
|
if ( exists $keyword{metadata} ) { |
316
|
3
|
|
|
|
|
10
|
RPC::ExtDirect::Util::decode_metadata($self, \%keyword); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
# Remove extType because it's meaningless later on |
320
|
6
|
|
|
|
|
82
|
delete $keyword{ extType }; |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
# Fix TID so that it comes as a number (JavaScript is picky) |
323
|
6
|
50
|
|
|
|
16
|
$keyword{ extTID } += 0 if exists $keyword{ extTID }; |
324
|
|
|
|
|
|
|
|
325
|
6
|
|
|
|
|
11
|
return \%keyword; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
329
|
|
|
|
|
|
|
# |
330
|
|
|
|
|
|
|
# Takes info from Plack::Request::Upload and formats it as needed |
331
|
|
|
|
|
|
|
# |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub _format_uploads { |
334
|
2
|
|
|
2
|
|
14
|
my ($self, @uploads) = @_; |
335
|
|
|
|
|
|
|
|
336
|
4
|
|
|
|
|
207
|
my @result = map { |
337
|
2
|
|
|
|
|
4
|
{ |
338
|
|
|
|
|
|
|
filename => $_->filename, |
339
|
|
|
|
|
|
|
basename => $_->basename, |
340
|
|
|
|
|
|
|
type => $_->content_type, |
341
|
|
|
|
|
|
|
size => $_->size, |
342
|
|
|
|
|
|
|
path => $_->path, |
343
|
|
|
|
|
|
|
handle => IO::File->new($_->path, 'r'), |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
@uploads; |
347
|
|
|
|
|
|
|
|
348
|
2
|
|
|
|
|
224
|
return @result; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
352
|
|
|
|
|
|
|
# |
353
|
|
|
|
|
|
|
# Returns error response in Plack format |
354
|
|
|
|
|
|
|
# |
355
|
|
|
|
|
|
|
|
356
|
0
|
|
|
0
|
|
0
|
sub _error_response { [ 500, [ 'Content-Type' => 'text/html' ], [] ] } |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
# Small utility class |
359
|
|
|
|
|
|
|
package |
360
|
|
|
|
|
|
|
Plack::Middleware::ExtDirect::Env; |
361
|
|
|
|
|
|
|
|
362
|
4
|
|
|
4
|
|
1277
|
use parent 'Plack::Request'; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
23
|
|
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
sub http { |
365
|
2
|
|
|
2
|
|
6445
|
my ($self, $name) = @_; |
366
|
|
|
|
|
|
|
|
367
|
2
|
|
|
|
|
12
|
my $hdr = $self->headers; |
368
|
|
|
|
|
|
|
|
369
|
2
|
100
|
|
|
|
278
|
return $name ? $hdr->header($name) |
370
|
|
|
|
|
|
|
: $hdr->header_field_names |
371
|
|
|
|
|
|
|
; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
sub param { |
375
|
2
|
|
|
2
|
|
2042
|
my ($self, $name) = @_; |
376
|
|
|
|
|
|
|
|
377
|
2
|
50
|
|
|
|
16
|
return $name eq 'POSTDATA' ? $self->content |
|
|
100
|
|
|
|
|
|
378
|
|
|
|
|
|
|
: $name eq '' ? ( $self->SUPER::param(), 'POSTDATA' ) |
379
|
|
|
|
|
|
|
: $self->SUPER::param($name) |
380
|
|
|
|
|
|
|
; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
sub cookie { |
384
|
2
|
|
|
2
|
|
2159
|
my ($self, $name) = @_; |
385
|
|
|
|
|
|
|
|
386
|
1
|
|
|
|
|
7
|
return $name ? $self->cookies()->{ $name } |
387
|
2
|
100
|
|
|
|
7
|
: keys %{ $self->cookies() } |
388
|
|
|
|
|
|
|
; |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
1; |