simple param parser

diff --git a/lib/Web/Simple/ParamParser.pm b/lib/Web/Simple/ParamParser.pm
new file mode 100644 (file)
index 0000000..ad14ab5
--- /dev/null
+++ b/lib/Web/Simple/ParamParser.pm
@@ -0,0 +1,40 @@
+package Web::Simple::ParamParser;
+
+use strict;
+use warnings FATAL => 'all';
+
+sub UNPACKED_QUERY () { __PACKAGE__.'.unpacked_query' }
+
+sub get_unpacked_query_from {
+  return $_[0]->{+UNPACKED_QUERY} ||= do {
+    _unpack_params($_[0]->{QUERY_STRING})
+  };
+}
+
+{
+  # shamelessly stolen from HTTP::Body::UrlEncoded by Christian Hansen
+
+  my $DECODE = qr/%([0-9a-fA-F]{2})/;
+
+  my %hex_chr;
+
+  foreach my $num ( 0 .. 255 ) {
+    my $h = sprintf "%02X", $num;
+    $hex_chr{ lc $h } = $hex_chr{ uc $h } = chr $num;
+  }
+
+  sub _unpack_params {
+    my %unpack;
+    my ($name, $value);
+    foreach my $pair (split(/[&;](?:\s+)?/, $_[0])) {
+      next unless (($name, $value) = split(/=/, $pair, 2)) == 2;
+        
+      s/$DECODE/$hex_chr{$1}/gs for ($name, $value);
+
+      push(@{$unpack{$name}||=[]}, $value);
+    }
+    \%unpack;
+  }
+}
+
+1;

diff --git a/t/param_parser.t b/t/param_parser.t
new file mode 100644 (file)
index 0000000..b6c0f71
--- /dev/null
+++ b/t/param_parser.t
@@ -0,0 +1,41 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More qw(no_plan);
+
+use Web::Simple::ParamParser;
+
+use Data::Dumper::Concise;
+
+my $param_sample = 'foo=bar&baz=quux&foo=%2F';
+my $unpacked = {
+  baz => [
+    "quux"
+  ],
+  foo => [
+    "bar",
+    "/"
+  ]
+};
+
+is_deeply(
+  Web::Simple::ParamParser::_unpack_params('foo=bar&baz=quux&foo=%2F'),
+  $unpacked,
+  'Simple unpack ok'
+);
+
+my $env = { 'QUERY_STRING' => $param_sample };
+
+is_deeply(
+  Web::Simple::ParamParser::get_unpacked_query_from($env),
+  $unpacked,
+  'Dynamic unpack ok'
+);
+
+is_deeply(
+  $env->{+Web::Simple::ParamParser::UNPACKED_QUERY},
+  $unpacked,
+  'Unpack cached ok'
+);
+
+1;