Commit | Line | Data |
134d6c1f |
1 | package Web::Simple::ParamParser; |
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 { |
17 | if (($_[0]->{CONTENT_TYPE}||'') eq 'application/x-www-form-urlencoded' |
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 | |
134d6c1f |
27 | { |
28 | # shamelessly stolen from HTTP::Body::UrlEncoded by Christian Hansen |
29 | |
30 | my $DECODE = qr/%([0-9a-fA-F]{2})/; |
31 | |
32 | my %hex_chr; |
33 | |
34 | foreach my $num ( 0 .. 255 ) { |
35 | my $h = sprintf "%02X", $num; |
36 | $hex_chr{ lc $h } = $hex_chr{ uc $h } = chr $num; |
37 | } |
38 | |
39 | sub _unpack_params { |
40 | my %unpack; |
a5917caa |
41 | (my $params = $_[0]) =~ s/\+/ /g; |
134d6c1f |
42 | my ($name, $value); |
a5917caa |
43 | foreach my $pair (split(/[&;](?:\s+)?/, $params)) { |
134d6c1f |
44 | next unless (($name, $value) = split(/=/, $pair, 2)) == 2; |
45 | |
46 | s/$DECODE/$hex_chr{$1}/gs for ($name, $value); |
47 | |
48 | push(@{$unpack{$name}||=[]}, $value); |
49 | } |
50 | \%unpack; |
51 | } |
52 | } |
53 | |
54 | 1; |