Commit | Line | Data |
b6bf9ed3 |
1 | package Web::Dispatch::ParamParser; |
134d6c1f |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | |
6 | sub UNPACKED_QUERY () { __PACKAGE__.'.unpacked_query' } |
53d47b78 |
7 | sub UNPACKED_BODY () { __PACKAGE__.'.unpacked_body' } |
134d6c1f |
8 | |
9 | sub get_unpacked_query_from { |
10 | return $_[0]->{+UNPACKED_QUERY} ||= do { |
11 | _unpack_params($_[0]->{QUERY_STRING}) |
12 | }; |
13 | } |
14 | |
53d47b78 |
15 | sub get_unpacked_body_from { |
16 | return $_[0]->{+UNPACKED_BODY} ||= do { |
206620db |
17 | if (index(lc($_[0]->{CONTENT_TYPE}||''), 'application/x-www-form-urlencoded') >= 0 |
53d47b78 |
18 | and defined $_[0]->{CONTENT_LENGTH}) { |
19 | $_[0]->{'psgi.input'}->read(my $buf, $_[0]->{CONTENT_LENGTH}); |
20 | _unpack_params($buf); |
21 | } else { |
22 | {} |
23 | } |
24 | }; |
25 | } |
26 | |
206620db |
27 | |
134d6c1f |
28 | { |
29 | # shamelessly stolen from HTTP::Body::UrlEncoded by Christian Hansen |
30 | |
31 | my $DECODE = qr/%([0-9a-fA-F]{2})/; |
32 | |
33 | my %hex_chr; |
34 | |
35 | foreach my $num ( 0 .. 255 ) { |
36 | my $h = sprintf "%02X", $num; |
37 | $hex_chr{ lc $h } = $hex_chr{ uc $h } = chr $num; |
38 | } |
39 | |
40 | sub _unpack_params { |
41 | my %unpack; |
a5917caa |
42 | (my $params = $_[0]) =~ s/\+/ /g; |
134d6c1f |
43 | my ($name, $value); |
a5917caa |
44 | foreach my $pair (split(/[&;](?:\s+)?/, $params)) { |
134d6c1f |
45 | next unless (($name, $value) = split(/=/, $pair, 2)) == 2; |
46 | |
47 | s/$DECODE/$hex_chr{$1}/gs for ($name, $value); |
48 | |
49 | push(@{$unpack{$name}||=[]}, $value); |
50 | } |
51 | \%unpack; |
52 | } |
53 | } |
54 | |
55 | 1; |