line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Kossy::Request; |
2
|
|
|
|
|
|
|
|
3
|
8
|
|
|
8
|
|
31439
|
use strict; |
|
8
|
|
|
|
|
10
|
|
|
8
|
|
|
|
|
172
|
|
4
|
8
|
|
|
8
|
|
120
|
use warnings; |
|
8
|
|
|
|
|
6
|
|
|
8
|
|
|
|
|
170
|
|
5
|
8
|
|
|
8
|
|
23
|
use parent qw/Plack::Request/; |
|
8
|
|
|
|
|
8
|
|
|
8
|
|
|
|
|
33
|
|
6
|
8
|
|
|
8
|
|
288235
|
use Hash::MultiValue; |
|
8
|
|
|
|
|
12
|
|
|
8
|
|
|
|
|
118
|
|
7
|
8
|
|
|
8
|
|
471
|
use Encode; |
|
8
|
|
|
|
|
6448
|
|
|
8
|
|
|
|
|
460
|
|
8
|
8
|
|
|
8
|
|
30
|
use HTTP::Headers::Fast; |
|
8
|
|
|
|
|
7
|
|
|
8
|
|
|
|
|
128
|
|
9
|
8
|
|
|
8
|
|
3079
|
use Kossy::Validator; |
|
8
|
|
|
|
|
10197
|
|
|
8
|
|
|
|
|
197
|
|
10
|
8
|
|
|
8
|
|
3154
|
use HTTP::Entity::Parser; |
|
8
|
|
|
|
|
72136
|
|
|
8
|
|
|
|
|
208
|
|
11
|
8
|
|
|
8
|
|
41
|
use WWW::Form::UrlEncoded qw/parse_urlencoded_arrayref build_urlencoded_utf8/; |
|
8
|
|
|
|
|
8
|
|
|
8
|
|
|
|
|
328
|
|
12
|
8
|
|
|
8
|
|
391
|
use Cookie::Baker; |
|
8
|
|
|
|
|
1422
|
|
|
8
|
|
|
|
|
7650
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $VERSION = '0.40'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub new { |
17
|
29
|
|
|
29
|
1
|
37097
|
my($class, $env, %opts) = @_; |
18
|
29
|
50
|
33
|
|
|
145
|
Carp::croak(q{$env is required}) |
19
|
|
|
|
|
|
|
unless defined $env && ref($env) eq 'HASH'; |
20
|
|
|
|
|
|
|
|
21
|
29
|
|
|
|
|
142
|
bless { |
22
|
|
|
|
|
|
|
%opts, |
23
|
|
|
|
|
|
|
env => $env, |
24
|
|
|
|
|
|
|
}, $class; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub new_response { |
28
|
5
|
|
|
5
|
1
|
2275
|
my $self = shift; |
29
|
5
|
|
|
|
|
368
|
require Kossy::Response; |
30
|
5
|
|
|
|
|
22
|
Kossy::Response->new(@_); |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub cookies { |
34
|
7
|
|
|
7
|
1
|
1089
|
my $self = shift; |
35
|
|
|
|
|
|
|
|
36
|
7
|
100
|
|
|
|
18
|
return {} unless $self->env->{HTTP_COOKIE}; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# HTTP_COOKIE hasn't changed: reuse the parsed cookie |
39
|
6
|
100
|
66
|
|
|
31
|
if ( $self->env->{'plack.cookie.parsed'} |
40
|
|
|
|
|
|
|
&& $self->env->{'plack.cookie.string'} eq $self->env->{HTTP_COOKIE}) { |
41
|
4
|
|
|
|
|
36
|
return $self->env->{'plack.cookie.parsed'}; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
2
|
|
|
|
|
14
|
$self->env->{'plack.cookie.string'} = $self->env->{HTTP_COOKIE}; |
45
|
2
|
|
|
|
|
9
|
$self->env->{'plack.cookie.parsed'} = crush_cookie($self->env->{'plack.cookie.string'}); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub request_body_parser { |
50
|
7
|
|
|
7
|
0
|
28
|
my $self = shift; |
51
|
7
|
50
|
|
|
|
15
|
unless (exists $self->{request_body_parser}) { |
52
|
7
|
|
|
|
|
13
|
$self->{request_body_parser} = $self->_build_request_body_parser(); |
53
|
|
|
|
|
|
|
} |
54
|
7
|
|
|
|
|
22
|
return $self->{request_body_parser}; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
my $default_parser = HTTP::Entity::Parser->new(); |
58
|
|
|
|
|
|
|
$default_parser->register( |
59
|
|
|
|
|
|
|
'application/x-www-form-urlencoded', |
60
|
|
|
|
|
|
|
'HTTP::Entity::Parser::UrlEncoded' |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
$default_parser->register( |
63
|
|
|
|
|
|
|
'multipart/form-data', |
64
|
|
|
|
|
|
|
'HTTP::Entity::Parser::MultiPart' |
65
|
|
|
|
|
|
|
); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $json_parser = HTTP::Entity::Parser->new(); |
68
|
|
|
|
|
|
|
$json_parser->register( |
69
|
|
|
|
|
|
|
'application/x-www-form-urlencoded', |
70
|
|
|
|
|
|
|
'HTTP::Entity::Parser::UrlEncoded' |
71
|
|
|
|
|
|
|
); |
72
|
|
|
|
|
|
|
$json_parser->register( |
73
|
|
|
|
|
|
|
'multipart/form-data', |
74
|
|
|
|
|
|
|
'HTTP::Entity::Parser::MultiPart' |
75
|
|
|
|
|
|
|
); |
76
|
|
|
|
|
|
|
$json_parser->register( |
77
|
|
|
|
|
|
|
'application/json', |
78
|
|
|
|
|
|
|
'HTTP::Entity::Parser::JSON' |
79
|
|
|
|
|
|
|
); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub _build_request_body_parser { |
82
|
7
|
|
|
7
|
|
7
|
my $self = shift; |
83
|
7
|
100
|
|
|
|
11
|
if ( $self->env->{'kossy.request.parse_json_body'} ) { |
84
|
5
|
|
|
|
|
18
|
return $json_parser; |
85
|
|
|
|
|
|
|
} |
86
|
2
|
|
|
|
|
11
|
$default_parser; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub _parse_request_body { |
90
|
11
|
|
|
11
|
|
24
|
my $self = shift; |
91
|
11
|
100
|
|
|
|
15
|
if ( !$self->env->{CONTENT_TYPE} ) { |
92
|
4
|
|
|
|
|
40
|
$self->env->{'kossy.request.body_parameters'} = []; |
93
|
4
|
|
|
|
|
13
|
$self->env->{'plack.request.upload'} = Hash::MultiValue->new(); |
94
|
4
|
|
|
|
|
65
|
return; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
7
|
|
|
|
|
27
|
my ($params,$uploads) = $self->request_body_parser->parse($self->env); |
98
|
7
|
|
|
|
|
1880
|
$self->env->{'kossy.request.body_parameters'} = $params; |
99
|
|
|
|
|
|
|
|
100
|
7
|
|
|
|
|
36
|
my $upload_hmv = Hash::MultiValue->new(); |
101
|
7
|
|
|
|
|
152
|
while ( my ($k,$v) = splice @$uploads, 0, 2 ) { |
102
|
1
|
|
|
|
|
5
|
my %copy = %$v; |
103
|
1
|
|
|
|
|
2
|
$copy{headers} = HTTP::Headers::Fast->new(@{$v->{headers}}); |
|
1
|
|
|
|
|
8
|
|
104
|
1
|
|
|
|
|
81
|
$upload_hmv->add($k, Plack::Request::Upload->new(%copy)); |
105
|
|
|
|
|
|
|
} |
106
|
7
|
|
|
|
|
74
|
$self->env->{'plack.request.upload'} = $upload_hmv; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub uploads { |
110
|
4
|
|
|
4
|
1
|
1353
|
my $self = shift; |
111
|
4
|
50
|
|
|
|
9
|
unless ($self->env->{'plack.request.upload'}) { |
112
|
0
|
|
|
|
|
0
|
$self->_parse_request_body; |
113
|
|
|
|
|
|
|
} |
114
|
4
|
|
|
|
|
18
|
$self->env->{'plack.request.upload'}; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub body_parameters { |
118
|
12
|
|
|
12
|
1
|
881
|
my ($self) = @_; |
119
|
|
|
|
|
|
|
$self->env->{'kossy.request.body'} ||= |
120
|
12
|
|
66
|
|
|
33
|
Hash::MultiValue->new(map { Encode::decode_utf8($_) } @{$self->_body_parameters()}); |
|
10
|
|
|
|
|
149
|
|
|
11
|
|
|
|
|
50
|
|
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub query_parameters { |
124
|
13
|
|
|
13
|
1
|
873
|
my ($self) = @_; |
125
|
|
|
|
|
|
|
$self->env->{'kossy.request.query'} ||= |
126
|
13
|
|
66
|
|
|
23
|
Hash::MultiValue->new(map { Encode::decode_utf8($_) } @{$self->_query_parameters()}); |
|
18
|
|
|
|
|
174
|
|
|
11
|
|
|
|
|
43
|
|
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub parameters { |
130
|
19
|
|
|
19
|
1
|
3616
|
my $self = shift; |
131
|
19
|
|
66
|
|
|
48
|
$self->env->{'kossy.request.merged'} ||= do { |
132
|
11
|
|
|
|
|
57
|
Hash::MultiValue->new( |
133
|
|
|
|
|
|
|
$self->query_parameters->flatten, |
134
|
|
|
|
|
|
|
$self->body_parameters->flatten, |
135
|
|
|
|
|
|
|
); |
136
|
|
|
|
|
|
|
}; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub _body_parameters { |
140
|
11
|
|
|
11
|
|
9
|
my $self = shift; |
141
|
11
|
100
|
|
|
|
17
|
unless ($self->env->{'kossy.request.body_parameters'}) { |
142
|
10
|
|
|
|
|
36
|
$self->_parse_request_body; |
143
|
|
|
|
|
|
|
} |
144
|
11
|
|
|
|
|
33
|
return $self->env->{'kossy.request.body_parameters'}; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
sub _query_parameters { |
147
|
11
|
|
|
11
|
|
9
|
my $self = shift; |
148
|
11
|
50
|
|
|
|
21
|
unless ( $self->env->{'kossy.request.query_parameters'} ) { |
149
|
|
|
|
|
|
|
$self->env->{'kossy.request.query_parameters'} = |
150
|
11
|
|
|
|
|
39
|
parse_urlencoded_arrayref($self->env->{'QUERY_STRING'}); |
151
|
|
|
|
|
|
|
} |
152
|
11
|
|
|
|
|
81
|
return $self->env->{'kossy.request.query_parameters'}; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub body_parameters_raw { |
156
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
157
|
0
|
0
|
|
|
|
0
|
unless ($self->env->{'plack.request.body'}) { |
158
|
0
|
|
|
|
|
0
|
$self->env->{'plack.request.body'} = Hash::MultiValue->new(@{$self->_body_parameters}); |
|
0
|
|
|
|
|
0
|
|
159
|
|
|
|
|
|
|
} |
160
|
0
|
|
|
|
|
0
|
return $self->env->{'plack.request.body'}; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
sub query_parameters_raw { |
164
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
165
|
0
|
0
|
|
|
|
0
|
unless ($self->env->{'plack.request.query'}) { |
166
|
0
|
|
|
|
|
0
|
$self->env->{'plack.request.query'} = Hash::MultiValue->new(@{$self->_query_parameters}); |
|
0
|
|
|
|
|
0
|
|
167
|
|
|
|
|
|
|
} |
168
|
0
|
|
|
|
|
0
|
return $self->env->{'plack.request.query'}; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub parameters_raw { |
172
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
173
|
0
|
|
0
|
|
|
0
|
$self->env->{'plack.request.merged'} ||= do { |
174
|
|
|
|
|
|
|
Hash::MultiValue->new( |
175
|
0
|
|
|
|
|
0
|
@{$self->_query_parameters}, |
176
|
0
|
|
|
|
|
0
|
@{$self->_body_parameters} |
|
0
|
|
|
|
|
0
|
|
177
|
|
|
|
|
|
|
); |
178
|
|
|
|
|
|
|
}; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub param_raw { |
182
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
183
|
|
|
|
|
|
|
|
184
|
0
|
0
|
|
|
|
0
|
return keys %{ $self->parameters_raw } if @_ == 0; |
|
0
|
|
|
|
|
0
|
|
185
|
|
|
|
|
|
|
|
186
|
0
|
|
|
|
|
0
|
my $key = shift; |
187
|
0
|
0
|
|
|
|
0
|
return $self->parameters_raw->{$key} unless wantarray; |
188
|
0
|
|
|
|
|
0
|
return $self->parameters_raw->get_all($key); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub base { |
192
|
4
|
|
|
4
|
1
|
4
|
my $self = shift; |
193
|
4
|
|
50
|
|
|
18
|
$self->{_base} ||= {}; |
194
|
4
|
|
|
|
|
13
|
my $base = $self->_uri_base; |
195
|
4
|
|
33
|
|
|
46
|
$self->{_base}->{$base} ||= $self->SUPER::base; |
196
|
4
|
|
|
|
|
475
|
$self->{_base}->{$base}->clone; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub uri_for { |
200
|
4
|
|
|
4
|
0
|
35
|
my($self, $path, $args) = @_; |
201
|
4
|
|
|
|
|
8
|
my $uri = $self->base; |
202
|
4
|
100
|
|
|
|
18
|
my $base = $uri->path eq "/" |
203
|
|
|
|
|
|
|
? "" |
204
|
|
|
|
|
|
|
: $uri->path; |
205
|
4
|
|
|
|
|
42
|
my $query = ''; |
206
|
4
|
100
|
|
|
|
9
|
if ( $args ) { |
207
|
2
|
|
|
|
|
18
|
$query = build_urlencoded_utf8($args); |
208
|
|
|
|
|
|
|
} |
209
|
4
|
100
|
|
|
|
17
|
$uri->path_query( $base . $path . (length $query ? "?$query" : "")); |
210
|
4
|
|
|
|
|
111
|
$uri; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub validator { |
214
|
0
|
|
|
0
|
0
|
|
my ($self, $rule) = @_; |
215
|
0
|
|
|
|
|
|
Kossy::Validator->check($self,$rule); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
1; |