Add support for form input

Changes

@@ -1,3 +1,6 @@
+0.94
+    * Add support for form input;
+
 0.93
     * Take `result_class` of `DBIx::Class::ResultSet` instead of asking for columns info on the actual data row (#110);
 

lib/Raisin/Decoder.pm

@@ -13,6 +13,7 @@ sub builtin {
     {
         json => 'Raisin::Encoder::JSON',
         yaml => 'Raisin::Encoder::YAML',
+        form => 'Raisin::Encoder::Form',
     };
 }
 

lib/Raisin/Encoder/Form.pm

@@ -0,0 +1,30 @@
+#!perl
+#PODNAME: Raisin::Encoder::Form
+#ABSTRACT: Form deserialization plugin for Raisin.
+
+use strict;
+use warnings;
+
+package Raisin::Encoder::Form;
+
+use Encode qw(decode_utf8);
+
+sub detectable_by { [qw(application/x-www-form-urlencoded multipart/form-data)] }
+sub content_type { 'text/plain; charset=utf-8' }
+
+sub serialize {
+    Raisin::log(error => 'Raisin:Encoder::Form doesn\'t support serialization');
+    die;
+}
+
+sub deserialize { $_[1]->body_parameters }
+
+1;
+
+__END__
+
+=head1 DESCRIPTION
+
+Provides C<deserialize> method to decode HTML form data requests.
+
+=cut

lib/Raisin/Encoder/JSON.pm

@@ -17,7 +17,7 @@ sub content_type { 'application/json; charset=utf-8' }
 
 sub serialize { $json->allow_blessed->convert_blessed->encode($_[1]) }
 
-sub deserialize { $json->allow_blessed->convert_blessed->decode($_[1]) }
+sub deserialize { $json->allow_blessed->convert_blessed->decode($_[1]->content) }
 
 1;
 

lib/Raisin/Encoder/YAML.pm

@@ -13,7 +13,7 @@ use YAML qw(Dump Load);
 sub detectable_by { [qw(application/x-yaml application/yaml text/x-yaml text/yaml yaml)] }
 sub content_type { 'application/x-yaml' }
 sub serialize { encode_utf8( Dump($_[1]) ) }
-sub deserialize { Load( decode_utf8($_[1]) ) }
+sub deserialize { Load( decode_utf8($_[1]->content) ) }
 
 1;
 

lib/Raisin/Middleware/Formatter.pm

@@ -40,7 +40,7 @@ sub call {
         $env->{'raisinx.decoder'} = $format;
 
         my $d = Plack::Util::load_class($self->decoder->for($format));
-        $env->{'raisinx.body_params'} = $d->deserialize($req->content);
+        $env->{'raisinx.body_params'} = $d->deserialize($req);
     }
 
     my $format = $self->negotiate_format($req);

t/behaviour/app-deserialize.t

@@ -50,27 +50,29 @@ test_psgi $app, sub {
     my $cb = shift;
 
     subtest 'application/yaml' => sub {
-        my $res = $cb->(POST '/api', 'Content-Type' => 'application/yaml',
-            Content => encode_utf8(Dump(\%DATA))
-        );
+        my $res = $cb->(POST '/api', 'Content-Type' => 'application/yaml', Content => encode_utf8(Dump(\%DATA)));
 
         is $res->header('Content-Type'), 'application/x-yaml', 'content-type';
         my $pp = Load( decode_utf8($res->content) );
         is_deeply $pp->{params}, \%DATA, 'parameters match';
     };
 
     subtest 'application/json' => sub {
-        my $res = $cb->(POST '/api', 'Content-Type' => 'application/json',
-            Content => encode_json(\%DATA));
+        my $res = $cb->(POST '/api', 'Content-Type' => 'application/json', Content => encode_json(\%DATA));
 
         is $res->header('Content-Type'), 'application/x-yaml', 'content-type';
         my $pp = Load( decode_utf8($res->content) );
         is_deeply $pp->{params}, \%DATA, 'parameters match';
     };
 
     subtest 'x-www-form-urlencoded' => sub {
+        plan skip_all => 'HTTP::Message UTF8 encode/decode';
+
         my $res = $cb->(POST '/api', [%DATA]);
-        is $res->code, HTTP_UNSUPPORTED_MEDIA_TYPE, 'unsupported';
+
+        is $res->header('Content-Type'), 'application/x-yaml', 'content-type';
+        my $pp = Load( decode_utf8($res->content) );
+        is_deeply $pp->{params}, \%DATA, 'parameters match';
     };
 };
 

t/behaviour/app-routes.t

@@ -89,7 +89,17 @@ test_psgi $app, sub {
 
         subtest "POST /api/$case->{namespace}" => sub {
             my $res = $cb->(POST "/api/$case->{namespace}", [%NEW]);
-            is $res->code, HTTP_UNSUPPORTED_MEDIA_TYPE;
+
+            if (!is $res->code, 200) {
+                diag $res->content;
+                BAIL_OUT 'FAILED!';
+            }
+
+            ok my $c = $res->content, 'content';
+            ok my $o = Load($c), 'decode';
+            is $o->{success}, $IDS[-1] + 1, 'success';
+
+            push @IDS, $o->{success};
         };
 
         subtest "POST /api/$case->{namespace}" => sub {

t/unit/encoder/form.t

@@ -0,0 +1,38 @@
+
+use strict;
+use warnings;
+
+use HTTP::Message::PSGI;
+use HTTP::Request::Common;
+use Plack::Request;
+use Test::More;
+
+use Raisin::Encoder::Form;
+
+subtest 'detectable_by' => sub {
+    my @ct = Raisin::Encoder::Form->detectable_by;
+    is_deeply $ct[0], [qw(application/x-www-form-urlencoded multipart/form-data)];
+};
+
+subtest 'deserialize' => sub {
+    my @CASES = (
+        # form-urlencoded
+        {
+            env => POST('http://www.perl.org/survey.cgi', Content => [ name => 'Bruce Wayne' ])->to_psgi,
+            expected => { name => 'Bruce Wayne' },
+        },
+        # form-data
+        {
+            env => POST('http://www.perl.org/survey.cgi', Content_Type => 'form-data', Content => [ name => 'Bruce Wayne' ])->to_psgi,
+            expected => { name => 'Bruce Wayne' },
+        }
+    );
+    for my $c (@CASES) {
+        my $req  = Plack::Request->new( $c->{env} );
+        my $data = Raisin::Encoder::Form->deserialize($req);
+
+        is_deeply $data, $c->{expected};
+    }
+};
+
+done_testing;