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' } |
7 | |
8 | sub get_unpacked_query_from { |
9 | return $_[0]->{+UNPACKED_QUERY} ||= do { |
10 | _unpack_params($_[0]->{QUERY_STRING}) |
11 | }; |
12 | } |
13 | |
14 | { |
15 | # shamelessly stolen from HTTP::Body::UrlEncoded by Christian Hansen |
16 | |
17 | my $DECODE = qr/%([0-9a-fA-F]{2})/; |
18 | |
19 | my %hex_chr; |
20 | |
21 | foreach my $num ( 0 .. 255 ) { |
22 | my $h = sprintf "%02X", $num; |
23 | $hex_chr{ lc $h } = $hex_chr{ uc $h } = chr $num; |
24 | } |
25 | |
26 | sub _unpack_params { |
27 | my %unpack; |
28 | my ($name, $value); |
29 | foreach my $pair (split(/[&;](?:\s+)?/, $_[0])) { |
30 | next unless (($name, $value) = split(/=/, $pair, 2)) == 2; |
31 | |
32 | s/$DECODE/$hex_chr{$1}/gs for ($name, $value); |
33 | |
34 | push(@{$unpack{$name}||=[]}, $value); |
35 | } |
36 | \%unpack; |
37 | } |
38 | } |
39 | |
40 | 1; |