first cut at body matching
Matt S Trout [Mon, 23 Nov 2009 21:51:31 +0000 (16:51 -0500)]
lib/Web/Simple/Application.pm
lib/Web/Simple/DispatchParser.pm
lib/Web/Simple/ParamParser.pm
t/bloggery.t
t/post.t [new file with mode: 0644]

index e11eef7..c00c50c 100644 (file)
@@ -202,8 +202,8 @@ sub _build_final_dispatcher {
   shift->_build_dispatcher({
     call => sub {
       [
-        500, [ 'Content-type', 'text/plain' ],
-        [ 'The management apologises but we have no idea how to handle that' ]
+        404, [ 'Content-type', 'text/plain' ],
+        [ 'Not found' ]
       ]
     }
   })
index f665d9f..0fe2c5a 100644 (file)
@@ -136,6 +136,10 @@ sub _parse_spec_section {
     # ?<param spec>
     /\G\?/gc and
       return $self->_parse_param_handler($_, 'query');
+
+    # %<param spec>
+    /\G\%/gc and
+      return $self->_parse_param_handler($_, 'body');
   }
   return; # () will trigger the blam in our caller
 }
index e1827d1..46f8533 100644 (file)
@@ -4,6 +4,7 @@ use strict;
 use warnings FATAL => 'all';
 
 sub UNPACKED_QUERY () { __PACKAGE__.'.unpacked_query' }
+sub UNPACKED_BODY () { __PACKAGE__.'.unpacked_body' }
 
 sub get_unpacked_query_from {
   return $_[0]->{+UNPACKED_QUERY} ||= do {
@@ -11,6 +12,18 @@ sub get_unpacked_query_from {
   };
 }
 
+sub get_unpacked_body_from {
+  return $_[0]->{+UNPACKED_BODY} ||= do {
+    if (($_[0]->{CONTENT_TYPE}||'') eq 'application/x-www-form-urlencoded'
+        and defined $_[0]->{CONTENT_LENGTH}) {
+      $_[0]->{'psgi.input'}->read(my $buf, $_[0]->{CONTENT_LENGTH});
+      _unpack_params($buf);
+    } else {
+      {}
+    }
+  };
+}
+
 {
   # shamelessly stolen from HTTP::Body::UrlEncoded by Christian Hansen
 
index 9ed2442..14f38d7 100644 (file)
@@ -1,5 +1,11 @@
 use strict;
 use warnings FATAL => 'all';
+
+use Test::More qw(no_plan);
+
+require_ok 'examples/bloggery/bloggery.cgi';
+
+__END__
 use Test::More (
   eval { require HTTP::Request::AsCGI }
     ? 'no_plan'
diff --git a/t/post.t b/t/post.t
new file mode 100644 (file)
index 0000000..4316808
--- /dev/null
+++ b/t/post.t
@@ -0,0 +1,60 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More (
+  eval { require HTTP::Request::AsCGI }
+    ? 'no_plan'
+    : (skip_all => 'No HTTP::Request::AsCGI')
+);
+
+{
+  use Web::Simple 'PostTest';
+  package PostTest;
+  dispatch [
+    sub (%foo=&bar~) {
+      $_[1]->{bar} ||= 'EMPTY';
+      [ 200,
+        [ "Content-type" => "text/plain" ],
+        [ join(' ',@{$_[1]}{qw(foo bar)}) ]
+      ]
+    },
+  ]
+}
+
+use HTTP::Request::Common qw(GET POST);
+
+my $app = PostTest->new;
+
+sub run_request {
+  my $request = shift;
+  my $c = HTTP::Request::AsCGI->new($request)->setup;
+  $app->run;
+  $c->restore;
+  return $c->response;
+}
+
+my $get = run_request(GET 'http://localhost/');
+
+cmp_ok($get->code, '==', 404, '404 on GET');
+
+my $no_body = run_request(POST 'http://localhost/');
+
+cmp_ok($no_body->code, '==', 404, '404 with empty body');
+
+my $no_foo = run_request(POST 'http://localhost/' => [ bar => 'BAR' ]);
+
+cmp_ok($no_foo->code, '==', 404, '404 with no foo param');
+
+my $no_bar = run_request(POST 'http://localhost/' => [ foo => 'FOO' ]);
+
+cmp_ok($no_bar->code, '==', 200, '200 with only foo param');
+
+is($no_bar->content, 'FOO EMPTY', 'bar defaulted');
+
+my $both = run_request(
+  POST 'http://localhost/' => [ foo => 'FOO', bar => 'BAR' ]
+);
+
+cmp_ok($both->code, '==', 200, '200 with both params');
+
+is($both->content, 'FOO BAR', 'both params returned');