useful errors on misused middleware in route definitions

[catagits/Web-Simple.git] / t / post.t

use strict;
use warnings FATAL => 'all';

use Test::More qw(no_plan);
use Encode 'decode_utf8';

{
  use Web::Simple 'PostTest';
  package PostTest;
  sub dispatch_request {
    sub (%:foo=&:bar~) {
      $_[1]->{bar} ||= 'EMPTY';
      [ 200,
        [ "Content-type" => "text/plain" ],
        [ join(' ',@{$_[1]}{qw(foo bar)}) ]
      ]
    },
    sub (*baz=) {
      [ 200,
        [ "Content-type" => "text/plain" ],
        [ $_[1]->reason || $_[1]->filename ],
      ]
    },
  }
}

use HTTP::Request::Common qw(GET POST);

my $app = PostTest->new;
sub run_request { $app->run_test_request(@_); }

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');

my $upload = run_request(
  POST 'http://localhost'
    => Content_Type => 'form-data'
    => Content => [
      foo => 'FOO',
      bar => 'BAR'
    ]
);

cmp_ok($upload->code, '==', 200, '200 with multipart');

is($upload->content, 'FOO BAR', 'both params returned');

my $upload_wrongtype = run_request(
  POST 'http://localhost'
    => [ baz => 'fleem' ]
);

is(
  $upload_wrongtype->content,
  'field baz exists with value fleem but body was not multipart/form-data',
  'error points out wrong body type'
);

my $upload_notupload = run_request(
  POST 'http://localhost'
    => Content_Type => 'form-data'
    => Content => [ baz => 'fleem' ]
);

is(
  $upload_notupload->content,
  'field baz exists with value fleem but was not an upload',
  'error points out field was not an upload'
);

my $upload_isupload = run_request(
  POST 'http://localhost'
    => Content_Type => 'form-data'
    => Content => [
      baz => [
        undef, 'TESTFILE',
        Content => 'test content', 'Content-Type' => 'text/plain'
      ],
    ]
);

is(
  $upload_isupload->content,
  'TESTFILE',
  'Actual upload returns filename ok'
);

my $utf8_req =  POST "http://localhost"
  => Content_Type => "form-data"
  => Content => [ foo => "FOOü", bar => "BAR" ];
my $utf8_expect = "FOOü BAR";

my $utf8 = run_request($utf8_req);
is($utf8->content, decode_utf8($utf8_expect), "params utf8-decoded by default");

my $utf8_bytes = PostTest->new( param_encoding => undef )
  ->run_test_request($utf8_req);
is($utf8_bytes->content, $utf8_expect, "disabling the param encoding works");

my $iso_req =  POST "http://localhost"
  => Content_Type => "form-data"
  => Content => [ foo => "FOO\x{FC}", bar => "BAR" ];
my $iso = PostTest->new( param_encoding => "iso-8859-15" )
  ->run_test_request($iso_req);
is($iso->content, "FOO\x{FC} BAR", "changing the param encoding works");

1;