line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use Kelp::Base 'Plack::Request'; |
3
|
21
|
|
|
21
|
|
543
|
|
|
21
|
|
|
|
|
36
|
|
|
21
|
|
|
|
|
155
|
|
4
|
|
|
|
|
|
|
use Encode; |
5
|
21
|
|
|
21
|
|
1696
|
use Carp; |
|
21
|
|
|
|
|
82
|
|
|
21
|
|
|
|
|
1335
|
|
6
|
21
|
|
|
21
|
|
108
|
use Try::Tiny; |
|
21
|
|
|
|
|
73
|
|
|
21
|
|
|
|
|
967
|
|
7
|
21
|
|
|
21
|
|
119
|
|
|
21
|
|
|
|
|
39
|
|
|
21
|
|
|
|
|
16247
|
|
8
|
|
|
|
|
|
|
attr -app => sub { croak "app is required" }; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# The stash is used to pass values from one route to another |
11
|
|
|
|
|
|
|
attr stash => sub { {} }; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# The named hash contains the values of the named placeholders |
14
|
|
|
|
|
|
|
attr named => sub { {} }; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# The name of the matched route for this request |
17
|
|
|
|
|
|
|
attr route_name => sub { undef }; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# If you're running the web app as a proxy, use Plack::Middleware::ReverseProxy |
20
|
|
|
|
|
|
|
|
21
|
1
|
|
|
1
|
1
|
3
|
my ( $class, %args ) = @_; |
22
|
0
|
|
|
0
|
1
|
0
|
my $self = $class->SUPER::new( delete $args{env} ); |
23
|
0
|
|
|
0
|
1
|
0
|
$self->{$_} = $args{$_} for keys %args; |
24
|
|
|
|
|
|
|
return $self; |
25
|
|
|
|
|
|
|
} |
26
|
202
|
|
|
202
|
1
|
658
|
|
27
|
202
|
|
|
|
|
804
|
my $self = shift; |
28
|
202
|
|
|
|
|
1998
|
return unless my $with = $self->headers->header('X-Requested-With'); |
29
|
202
|
|
|
|
|
746
|
return $with =~ /XMLHttpRequest/i; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my $self = shift; |
33
|
1
|
|
|
1
|
1
|
3
|
return unless $self->content_type; |
34
|
1
|
50
|
|
|
|
6
|
return lc($self->content_type) =~ qr[^application/json]i; |
35
|
1
|
|
|
|
|
189
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $self = shift; |
39
|
76
|
|
|
76
|
1
|
92
|
my $safe_param = $self->app->config('safe_param') // 0; |
40
|
76
|
100
|
|
|
|
173
|
my $warn_message = |
41
|
43
|
|
|
|
|
228
|
'Using "param" with argument in list context is deprecated ' . |
42
|
|
|
|
|
|
|
'in Kelp version 1.04. See documentation of for details' |
43
|
|
|
|
|
|
|
; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
if ( $self->is_json && $self->app->can('json') ) { |
46
|
72
|
|
|
72
|
1
|
111
|
my $hash = try { |
47
|
72
|
|
100
|
|
|
143
|
$self->app->json->decode( $self->content ); |
48
|
72
|
|
|
|
|
112
|
} |
49
|
|
|
|
|
|
|
catch { |
50
|
|
|
|
|
|
|
{}; |
51
|
|
|
|
|
|
|
}; |
52
|
|
|
|
|
|
|
$hash = { ref($hash), $hash } unless ref($hash) eq 'HASH'; |
53
|
72
|
100
|
66
|
|
|
124
|
|
54
|
|
|
|
|
|
|
return $hash->{ $_[0] } if @_; |
55
|
21
|
|
|
21
|
|
728
|
return $hash if !wantarray; |
56
|
|
|
|
|
|
|
return keys %$hash; |
57
|
|
|
|
|
|
|
} |
58
|
1
|
|
|
1
|
|
197
|
|
59
|
21
|
|
|
|
|
104
|
# unsafe method - Plack::Request::param |
60
|
21
|
100
|
|
|
|
4182
|
if (@_ && wantarray && !$safe_param) { |
61
|
|
|
|
|
|
|
carp $warn_message; |
62
|
21
|
100
|
|
|
|
96
|
return $self->SUPER::param(@_); |
63
|
7
|
100
|
|
|
|
21
|
} |
64
|
4
|
|
|
|
|
30
|
|
65
|
|
|
|
|
|
|
# safe method without calling PLack::Request::param |
66
|
|
|
|
|
|
|
return $self->parameters->get($_[0]) if @_; |
67
|
|
|
|
|
|
|
return keys %{ $self->parameters }; |
68
|
51
|
100
|
100
|
|
|
524
|
} |
|
|
|
100
|
|
|
|
|
69
|
14
|
|
|
|
|
2040
|
|
70
|
14
|
|
|
|
|
360
|
shift->SUPER::param(@_); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my $self = shift; |
74
|
37
|
100
|
|
|
|
107
|
my $session = $self->env->{'psgix.session'} |
75
|
9
|
|
|
|
|
12
|
// die "No Session middleware wrapped"; |
|
9
|
|
|
|
|
30
|
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
return $session if !@_; |
78
|
|
|
|
|
|
|
|
79
|
0
|
|
|
0
|
1
|
0
|
if ( @_ == 1 ) { |
80
|
|
|
|
|
|
|
my $value = shift; |
81
|
|
|
|
|
|
|
return $session->{$value} unless ref $value; |
82
|
|
|
|
|
|
|
return $self->env->{'psgix.session'} = $value; |
83
|
10
|
|
|
10
|
1
|
27
|
} |
84
|
10
|
|
50
|
|
|
34
|
|
85
|
|
|
|
|
|
|
my %hash = @_; |
86
|
|
|
|
|
|
|
$session->{$_} = $hash{$_} for keys %hash; |
87
|
10
|
100
|
|
|
|
52
|
return $session; |
88
|
|
|
|
|
|
|
} |
89
|
8
|
100
|
|
|
|
16
|
|
90
|
5
|
|
|
|
|
8
|
1; |
91
|
5
|
100
|
|
|
|
25
|
|
92
|
1
|
|
|
|
|
4
|
|
93
|
|
|
|
|
|
|
=pod |
94
|
|
|
|
|
|
|
|
95
|
3
|
|
|
|
|
14
|
=head1 NAME |
96
|
3
|
|
|
|
|
29
|
|
97
|
3
|
|
|
|
|
17
|
Kelp::Request - Request class for a Kelp application |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head1 SYNOPSIS |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
my $request = Kelp::Request( app => $app, env => $env ); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head1 DESCRIPTION |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
This module provides a convenience layer on top of L<Plack::Request>. It extends |
106
|
|
|
|
|
|
|
it to add several convenience methods. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head2 app |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
A reference to the Kelp application. |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head2 stash |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
Returns a hashref, which represents the stash of the current the request |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
An all use, utility hash to use to pass information between routes. The stash |
119
|
|
|
|
|
|
|
is a concept originally conceived by the developers of L<Catalyst>. It's a hash |
120
|
|
|
|
|
|
|
that you can use to pass data from one route to another. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# put value into stash |
123
|
|
|
|
|
|
|
$self->req->stash->{username} = app->authenticate(); |
124
|
|
|
|
|
|
|
# more convenient way |
125
|
|
|
|
|
|
|
$self->stash->{username} = app->authenticate(); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# get value from stash |
128
|
|
|
|
|
|
|
return "Hello " . $self->req->stash->{username}; |
129
|
|
|
|
|
|
|
# more convenient way |
130
|
|
|
|
|
|
|
return "Hello " . $self->stash('username'); |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head2 named |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
This hash is initialized with the named placeholders of the path that the |
135
|
|
|
|
|
|
|
current route is processing. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head2 route_name |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
Contains a string name of the route matched for this request. Contains route pattern |
140
|
|
|
|
|
|
|
if the route was not named. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head2 param |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
I<B<Change of behavior> in version 1.04, see below for details> |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Returns the HTTP parameters of the request. This method delegates all the work |
147
|
|
|
|
|
|
|
to L<Plack::Request/param>, except when the content type of the request is |
148
|
|
|
|
|
|
|
C<application/json> and a JSON module is loaded. In that case, it will decode |
149
|
|
|
|
|
|
|
the JSON body and return as follows: |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=over |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=item |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
If no arguments are passed, then it will return the names of the HTTP parameters |
156
|
|
|
|
|
|
|
when called in array contest, and a reference to the entire JSON hash when |
157
|
|
|
|
|
|
|
called in scalar context. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# JSON body = { bar => 1, foo => 2 } |
160
|
|
|
|
|
|
|
my @names = $self->param; # @names = ('bar', 'foo') |
161
|
|
|
|
|
|
|
my $json = $self->param; # $json = { bar => 1, foo => 2 } |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=item |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
If a single argument is passed, then the corresponding value in the JSON |
167
|
|
|
|
|
|
|
document is returned. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
my $bar = $self->param('bar'); # $bar = 1 |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=item |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
If the root contents of the JSON document is not an C<HASH> (after decoding), then it will be wrapped into a hash with its reftype as a key, for example: |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
{ ARRAY => [...] } # when JSON contains an array as root element |
176
|
|
|
|
|
|
|
{ '' => [...] } # when JSON contains something that's not a reference |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
my $array = $kelp->param('ARRAY'); |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=back |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
Since version I<1.04>, a new application configuration field C<safe_param> is |
183
|
|
|
|
|
|
|
introduced that B<changes the behavior> of this method: |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=over |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=item |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Without C<safe_param>, method will produce a warning if used in list context |
190
|
|
|
|
|
|
|
while passing the first argument, but will continue to work the same. This is |
191
|
|
|
|
|
|
|
done to combat a very nasty and easy to make bug: |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
$kelp->some_function( |
194
|
|
|
|
|
|
|
param1 => $value, |
195
|
|
|
|
|
|
|
param2 => $kelp->param('key'), # BUG, list context |
196
|
|
|
|
|
|
|
); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Since HTTP requests can accept multiple values for the same key, someone could |
199
|
|
|
|
|
|
|
inject additional parameters to the function with the simple query, due to |
200
|
|
|
|
|
|
|
array flattening: |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
?key=something&key=additional_hash_key&key=additional_hash_value |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=item |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
With C<safe_param>, a call to C<param> with an argument (a key to fetch from |
207
|
|
|
|
|
|
|
the parameters) will no longer return a list but always a scalar value |
208
|
|
|
|
|
|
|
regardless of context, even if there are more than one entries of that name |
209
|
|
|
|
|
|
|
(will then return the last one). This makes usages like the one above perfectly |
210
|
|
|
|
|
|
|
safe. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
my @array = $kelp->param('name'); # changed, will never return more than one scalar |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=item |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Since this method has so many ways to use it, you're still B<encouraged> to use |
217
|
|
|
|
|
|
|
other, more specific methods from L<Plack::Request>. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=back |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
You are B<strongly advised> to introduce C<safe_param> into your configuration as |
222
|
|
|
|
|
|
|
quickly as possible. Currently, a value of C<0> is the default, meaning that |
223
|
|
|
|
|
|
|
param will work the same as it did, but produce warnings. In no less than half |
224
|
|
|
|
|
|
|
a year from version 1.04 the old behavior of C<param> will be removed |
225
|
|
|
|
|
|
|
altogether, and C<safe_param> configuration will no longer cause any change in |
226
|
|
|
|
|
|
|
behavior, allowing for its safe removal. Use L</cgi_param> if you'd like to |
227
|
|
|
|
|
|
|
retain the old behavior regardless of security risks. |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=head2 cgi_param |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
Calls C<param> in L<Plack::Request>, which is CGI.pm compatible. It is B<not |
232
|
|
|
|
|
|
|
recommended> to use this method, unless for some reason you have to maintain |
233
|
|
|
|
|
|
|
CGI.pm compatibility. Misusing this method can lead to bugs and security |
234
|
|
|
|
|
|
|
vulnerabilities. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head2 address, remote_host, user |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
These are shortcuts to the REMOTE_ADDR, REMOTE_HOST and REMOTE_USER environment |
239
|
|
|
|
|
|
|
variables. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
if ( $self->req->address eq '127.0.0.1' ) { |
242
|
|
|
|
|
|
|
... |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
Note: See L<Kelp::Cookbook/Deploying> for configuration required for these |
246
|
|
|
|
|
|
|
fields when using a proxy. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=head2 session |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Returns the Plack session hash or dies if no C<Session> middleware was included. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
sub get_session_value { |
253
|
|
|
|
|
|
|
my $self = shift; |
254
|
|
|
|
|
|
|
$self->session->{user} = 45; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
If called with a single argument, returns that value from the session hash: |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub set_session_value { |
260
|
|
|
|
|
|
|
my $self = shift; |
261
|
|
|
|
|
|
|
my $user = $self->req->session('user'); |
262
|
|
|
|
|
|
|
# Same as $self->req->session->{'user'}; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
Set values in the session using key-value pairs: |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
sub set_session_hash { |
268
|
|
|
|
|
|
|
my $self = shift; |
269
|
|
|
|
|
|
|
$self->req->session( |
270
|
|
|
|
|
|
|
name => 'Jill Andrews', |
271
|
|
|
|
|
|
|
age => 24, |
272
|
|
|
|
|
|
|
email => 'jill@perlkelp.com' |
273
|
|
|
|
|
|
|
); |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
Set values using a Hashref: |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub set_session_hashref { |
279
|
|
|
|
|
|
|
my $self = shift; |
280
|
|
|
|
|
|
|
$self->req->session( { bar => 'foo' } ); |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Clear the session: |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
sub clear_session { |
286
|
|
|
|
|
|
|
my $self = shift; |
287
|
|
|
|
|
|
|
$self->req->session( {} ); |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=head3 Common tasks with sessions |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=over |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=item Initialize file sessions |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
In your config file: |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
middleware => ['Session'], |
299
|
|
|
|
|
|
|
middleware_init => { |
300
|
|
|
|
|
|
|
Session => { |
301
|
|
|
|
|
|
|
store => 'File' |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=item Delete session value |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
delete $self->req->session->{'useless'}; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=item Remove all session values |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
$self->req->session( {} ); |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=back |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=head2 is_ajax |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
Returns true if the request was called with C<XMLHttpRequest>. |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=head2 is_json |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
Returns true if the request's content type was C<application/json>. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=cut |
324
|
|
|
|
|
|
|
|