view release on metacpan or  search on metacpan

t/request.t  view on Meta::CPAN

            REQUEST_URI => '/foo/bar/baz/',
        };
        $req = Dancer2::Core::Request->new( env => $env );
        is( $req->path, '/bar/baz/',
            'path corrent when both PATH_INFO and SCRIPT_NAME set'
        );
        is( $req->uri_base, 'http://localhost:5000/foo',
            'uri_base correct when both PATH_INFO and SCRIPT_NAME set',
        );

        # Neither SCRIPT_NAME or PATH_INFO set
        $env = {
            %$base,
            SCRIPT_NAME => '',
            PATH_INFO   => '',
            REQUEST_URI => '/foo/',
        };
        $req = Dancer2::Core::Request->new( env => $env );
        is( $req->path, '/',
            'path corrent when calculated from REQUEST_URI'
        );
        is( $req->uri_base, 'http://localhost:5000',
            'uri_base correct when calculated from REQUEST_URI',
        );
    }

    note "testing forward";
    $env = {
        'REQUEST_METHOD' => 'GET',
        'REQUEST_URI'    => '/',
        'PATH_INFO'      => '/',
        'QUERY_STRING'   => 'foo=bar&number=42',
    };

    $req = Dancer2::Core::Request->new( env => $env );
    is $req->path,   '/',   'path is /';
    is $req->method, 'GET', 'method is get';
    is_deeply scalar( $req->params ), { foo => 'bar', number => 42 },
      'params are parsed';

    $req = Dancer2::Core::App->new( request => $req )
                             ->make_forward_to('/new/path');
    is $req->path,   '/new/path', 'path is changed';
    is $req->method, 'GET',       'method is unchanged';
    is_deeply scalar( $req->params ), { foo => 'bar', number => 42 },
      'params are not touched';

    $req = Dancer2::Core::App->new( request => $req )
                             ->make_forward_to(
                                '/new/path',
                                undef,
                                { method => 'POST' },
                             );

    is $req->path,   '/new/path', 'path is changed';

    is $req->method, 'POST',      'method is changed';
    is_deeply scalar( $req->params ), { foo => 'bar', number => 42 },
      'params are not touched';

    note "testing unicode params";
    $env = {
        'REQUEST_METHOD' => 'GET',
        'REQUEST_URI'    => '/',
        'PATH_INFO'      => '/',
        'QUERY_STRING'   => "M%C3%BCller=L%C3%BCdenscheid",
    };
    $req = Dancer2::Core::Request->new( env => $env );
    is_deeply scalar( $req->params ), { "M\N{U+00FC}ller", "L\N{U+00FC}denscheid" },
      'multi byte unicode chars work in param keys and values';
    {
        note "testing private _decode not to mangle hash";
        my @warnings;
        local $SIG{__WARN__} = sub {
            push @warnings, @_;
        };

        my $h = { zzz => undef, };
        for ( 'aaa' .. 'fff' ) {
            $h->{$_} = $_;
        }

        my $i = Dancer2::Core::Request->_decode($h);
        is_deeply( $i, $h, 'hash not mangled' );
        ok( !@warnings, 'no warnings were issued' );
    }
}

note "Run test with XS_URL_DECODE" if $Dancer2::Core::Request::XS_URL_DECODE;
note "Run test with XS_PARSE_QUERY_STRING"
  if $Dancer2::Core::Request::XS_PARSE_QUERY_STRING;
run_test();
if ($Dancer2::Core::Request::XS_PARSE_QUERY_STRING) {
    note "Run test without XS_PARSE_QUERY_STRING";
    $Dancer2::Core::Request::XS_PARSE_QUERY_STRING = 0;
    $Dancer2::Core::Request::_id                   = 0;
    run_test();
}
if ($Dancer2::Core::Request::XS_URL_DECODE) {
    note "Run test without XS_URL_DECODE";
    $Dancer2::Core::Request::XS_URL_DECODE = 0;
    $Dancer2::Core::Request::_id           = 0;
    run_test();
}

done_testing;