line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Plack::Request::WithEncoding; |
2
|
2
|
|
|
2
|
|
36217
|
use 5.008_001; |
|
2
|
|
|
|
|
10
|
|
3
|
2
|
|
|
2
|
|
9
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
33
|
|
4
|
2
|
|
|
2
|
|
7
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
44
|
|
5
|
2
|
|
|
2
|
|
426
|
use parent qw/Plack::Request/; |
|
2
|
|
|
|
|
249
|
|
|
2
|
|
|
|
|
8
|
|
6
|
2
|
|
|
2
|
|
109412
|
use Encode (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
25
|
|
7
|
2
|
|
|
2
|
|
8
|
use Carp (); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
27
|
|
8
|
2
|
|
|
2
|
|
9
|
use Hash::MultiValue; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
59
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = "0.13"; |
11
|
|
|
|
|
|
|
|
12
|
2
|
|
|
2
|
|
10
|
use constant KEY_BASE_NAME => 'plack.request.withencoding'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
127
|
|
13
|
2
|
|
|
2
|
|
12
|
use constant DEFAULT_ENCODING => 'utf-8'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
1006
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub encoding { |
16
|
21
|
|
|
21
|
1
|
15922
|
my $env = $_[0]->env; |
17
|
21
|
|
|
|
|
66
|
my $k = KEY_BASE_NAME . '.encoding'; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# In order to be able to specify the `undef` into $req->env->{plack.request.withencoding.encoding} |
20
|
21
|
100
|
|
|
|
93
|
exists $env->{$k} ? $env->{$k} : ($env->{$k} = DEFAULT_ENCODING); |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub body_parameters { |
24
|
9
|
|
|
9
|
1
|
32882
|
my $self = shift; |
25
|
9
|
|
66
|
|
|
26
|
$self->env->{KEY_BASE_NAME . '.body'} ||= $self->_decode_parameters($self->SUPER::body_parameters); |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub query_parameters { |
29
|
7
|
|
|
7
|
1
|
1272
|
my $self = shift; |
30
|
7
|
|
100
|
|
|
16
|
$self->env->{KEY_BASE_NAME . '.query'} ||= $self->_decode_parameters($self->SUPER::query_parameters); |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub parameters { |
34
|
14
|
|
|
14
|
1
|
15835
|
my $self = shift; |
35
|
14
|
|
100
|
|
|
36
|
$self->env->{KEY_BASE_NAME . '.merged'} ||= do { |
36
|
4
|
|
|
|
|
23
|
my $query = $self->query_parameters; |
37
|
3
|
|
|
|
|
96
|
my $body = $self->body_parameters; |
38
|
3
|
|
|
|
|
55
|
Hash::MultiValue->new($query->flatten, $body->flatten); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub raw_body_parameters { |
43
|
2
|
|
|
2
|
1
|
3330
|
shift->SUPER::body_parameters; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub raw_query_parameters { |
47
|
1
|
|
|
1
|
1
|
4
|
shift->SUPER::query_parameters; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub raw_parameters { |
51
|
4
|
|
|
4
|
1
|
7
|
my $self = shift; |
52
|
|
|
|
|
|
|
|
53
|
4
|
|
66
|
|
|
10
|
$self->env->{'plack.request.merged'} ||= do { |
54
|
1
|
|
|
|
|
10
|
my $query = $self->SUPER::query_parameters(); |
55
|
1
|
|
|
|
|
130
|
my $body = $self->SUPER::body_parameters(); |
56
|
1
|
|
|
|
|
74
|
Hash::MultiValue->new( $query->flatten, $body->flatten ); |
57
|
|
|
|
|
|
|
}; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub raw_param { |
61
|
4
|
|
|
4
|
1
|
5115
|
my $self = shift; |
62
|
|
|
|
|
|
|
|
63
|
4
|
|
|
|
|
9
|
my $raw_parameters = $self->raw_parameters; |
64
|
4
|
50
|
|
|
|
73
|
return keys %{ $raw_parameters } if @_ == 0; |
|
0
|
|
|
|
|
0
|
|
65
|
|
|
|
|
|
|
|
66
|
4
|
|
|
|
|
6
|
my $key = shift; |
67
|
4
|
100
|
|
|
|
30
|
return $raw_parameters->{$key} unless wantarray; |
68
|
1
|
|
|
|
|
4
|
return $raw_parameters->get_all($key); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub _decode_parameters { |
72
|
10
|
|
|
10
|
|
1970
|
my ($self, $stuff) = @_; |
73
|
10
|
100
|
|
|
|
25
|
return $stuff unless $self->encoding; # return raw value if encoding method is `undef` |
74
|
|
|
|
|
|
|
|
75
|
7
|
|
|
|
|
15
|
my $encoding = Encode::find_encoding($self->encoding); |
76
|
7
|
100
|
|
|
|
9560
|
unless ($encoding) { |
77
|
1
|
|
|
|
|
4
|
my $invalid_encoding = $self->encoding; |
78
|
1
|
|
|
|
|
183
|
Carp::croak("Unknown encoding '$invalid_encoding'."); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
6
|
|
|
|
|
22
|
my @flatten = $stuff->flatten; |
82
|
6
|
|
|
|
|
76
|
my @decoded; |
83
|
6
|
|
|
|
|
24
|
while ( my ($k, $v) = splice @flatten, 0, 2 ) { |
84
|
8
|
|
|
|
|
82
|
push @decoded, $encoding->decode($k), $encoding->decode($v); |
85
|
|
|
|
|
|
|
} |
86
|
6
|
|
|
|
|
37
|
return Hash::MultiValue->new(@decoded); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
1; |
90
|
|
|
|
|
|
|
__END__ |