import the Plack::Request test suite

24 files changed, 761 insertions, 0 deletions

diff --git a/t/base.t b/t/base.t
new file mode 100644
index 0000000..af1a4ed
--- /dev/null
+++ b/t/base.t
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Request;
+
+my @tests = (
+  { host => 'localhost',
+    base => 'http://localhost/' },
+  { script_name => '/foo',
+    host => 'localhost',
+    base => 'http://localhost/foo' },
+  { script_name => '/foo bar',
+    host => 'localhost',
+    base => 'http://localhost/foo%20bar' },
+  { scheme => 'http',
+    host => 'localhost:91',
+    base => 'http://localhost:91/' },
+  { scheme => 'http',
+    host => 'example.com',
+    base => 'http://example.com/' },
+  { scheme => 'https',
+    host => 'example.com',
+    base => 'https://example.com/' },
+  { scheme => 'http',
+    server_name => 'example.com',
+    server_port => 80,
+    base => 'http://example.com/' },
+  { scheme => 'http',
+    server_name => 'example.com',
+    server_port => 8080,
+    base => 'http://example.com:8080/' },
+  { host => 'foobar.com',
+    server_name => 'example.com',
+    server_port => 8080,
+    base => 'http://foobar.com/' },
+);
+
+for my $block (@tests) {
+    my $env = {
+        'psgi.url_scheme' => $block->{scheme} || 'http',
+        HTTP_HOST => $block->{host} || undef,
+        SERVER_NAME => $block->{server_name} || undef,
+        SERVER_PORT => $block->{server_port} || undef,
+        SCRIPT_NAME => $block->{script_name} || '',
+    };
+
+    my $req = Web::Request->new_from_env($env);
+    is $req->base_uri, $block->{base};
+}
+
+done_testing;
diff --git a/t/body.t b/t/body.t
new file mode 100644
index 0000000..4c04bd2
--- /dev/null
+++ b/t/body.t
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+use Web::Request;
+
+my $app = sub {
+    my $req = Web::Request->new_from_env(shift);
+    is_deeply $req->body_parameters, { foo => 'bar' };
+    is $req->content, 'foo=bar';
+    $req->new_response(status => 200)->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+    my $res = $cb->(POST "/", { foo => "bar" });
+    ok $res->is_success;
+};
+
+done_testing;
diff --git a/t/content-on-get.t b/t/content-on-get.t
new file mode 100644
index 0000000..99df1b9
--- /dev/null
+++ b/t/content-on-get.t
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+use Web::Request;
+
+my $app = sub {
+    my $req = Web::Request->new_from_env(shift);
+    is $req->content, '';
+    $req->new_response(status => 200)->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+    my $res = $cb->(GET "/");
+    ok $res->is_success or diag $res->content;
+
+    $res = $cb->(HEAD "/");
+    ok $res->is_success or diag $res->content;
+};
+
+done_testing;
diff --git a/t/content.t b/t/content.t
new file mode 100644
index 0000000..aa39a1e
--- /dev/null
+++ b/t/content.t
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use Web::Request;
+
+my $app = sub {
+    my $req = Web::Request->new_from_env(shift);
+    is $req->content, 'body';
+    $req->new_response(status => 200)->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+
+    my $req = HTTP::Request->new(POST => "/");
+    $req->content("body");
+    $req->content_type('text/plain');
+    $req->content_length(4);
+    $cb->($req);
+};
+
+done_testing;
+
diff --git a/t/cookie.t b/t/cookie.t
new file mode 100644
index 0000000..b32b2d0
--- /dev/null
+++ b/t/cookie.t
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request;
+use Web::Request;
+
+my $app = sub {
+    my $req = Web::Request->new_from_env(shift);
+
+    is $req->cookies->{undef}, undef;
+    is $req->cookies->{Foo}, 'Bar';
+    is $req->cookies->{Bar}, 'Baz';
+    is $req->cookies->{XXX}, 'Foo Bar';
+    is $req->cookies->{YYY}, 0;
+
+    $req->new_response(status => 200)->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+    my $req = HTTP::Request->new(GET => "/");
+    $req->header(Cookie => 'Foo=Bar; Bar=Baz; XXX=Foo%20Bar; YYY=0; YYY=3');
+    $cb->($req);
+};
+
+$app = sub {
+    my $req = Web::Request->new_from_env(shift);
+    is_deeply $req->cookies, {};
+    $req->new_response(status => 200)->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+    $cb->(HTTP::Request->new(GET => "/"));
+};
+
+$app = sub {
+    my $warn = 0;
+    local $SIG{__WARN__} = sub { $warn++ };
+
+    my $req = Web::Request->new_from_env(shift);
+
+    is $req->cookies->{Foo}, 'Bar';
+    is $warn, 0;
+
+    $req->new_response(status => 200)->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb  = shift;
+    my $req = HTTP::Request->new(GET => "/");
+    $req->header(Cookie => 'Foo=Bar,; Bar=Baz;');
+    $cb->($req);
+};
+
+done_testing;
diff --git a/t/data/baybridge.jpg b/t/data/baybridge.jpg
new file mode 100644
index 0000000..484bcda
--- /dev/null
+++ b/t/data/baybridge.jpg
diff --git a/t/data/foo1.txt b/t/data/foo1.txt
new file mode 100644
index 0000000..257cc56
--- /dev/null
+++ b/t/data/foo1.txt
@@ -0,0 +1 @@
+foo
diff --git a/t/data/foo2.txt b/t/data/foo2.txt
new file mode 100644
index 0000000..257cc56
--- /dev/null
+++ b/t/data/foo2.txt
@@ -0,0 +1 @@
+foo
diff --git a/t/double_port.t b/t/double_port.t
new file mode 100644
index 0000000..2bb1c82
--- /dev/null
+++ b/t/double_port.t
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+use Web::Request;
+
+$Plack::Test::Impl = 'Server';
+local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI";
+
+my $app = sub {
+    my $req = Web::Request->new_from_env(shift);
+    return [200, [], [ $req->uri ]];
+};
+
+test_psgi app => $app, client => sub {
+    my $cb = shift;
+    my $res = $cb->(GET "http://localhost/foo");
+    ok $res->content !~ /:\d+:\d+/;
+};
+
+done_testing;
+
+
diff --git a/t/hostname.t b/t/hostname.t
new file mode 100644
index 0000000..7b0e20d
--- /dev/null
+++ b/t/hostname.t
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use Web::Request;
+
+my $req = Web::Request->new_from_env({ REMOTE_HOST => "foo.example.com" });
+is $req->remote_host, "foo.example.com";
+
+$req = Web::Request->new_from_env({ REMOTE_HOST => '', REMOTE_ADDR => '127.0.0.1' });
+is $req->address, "127.0.0.1";
+
+done_testing;
diff --git a/t/many_upload.t b/t/many_upload.t
new file mode 100644
index 0000000..77789a6
--- /dev/null
+++ b/t/many_upload.t
@@ -0,0 +1,77 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Request;
+
+my $content = qq{------BOUNDARY
+Content-Disposition: form-data; name="test_upload_file"; filename="yappo.txt"
+Content-Type: text/plain
+
+SHOGUN
+------BOUNDARY
+Content-Disposition: form-data; name="test_upload_file"; filename="yappo2.txt"
+Content-Type: text/plain
+
+SHOGUN2
+------BOUNDARY
+Content-Disposition: form-data; name="test_upload_file3"; filename="yappo3.txt"
+Content-Type: text/plain
+
+SHOGUN3
+------BOUNDARY
+Content-Disposition: form-data; name="test_upload_file4"; filename="yappo4.txt"
+Content-Type: text/plain
+
+SHOGUN4
+------BOUNDARY
+Content-Disposition: form-data; name="test_upload_file4"; filename="yappo5.txt"
+Content-Type: text/plain
+
+SHOGUN4
+------BOUNDARY
+Content-Disposition: form-data; name="test_upload_file6"; filename="yappo6.txt"
+Content-Type: text/plain
+
+SHOGUN6
+------BOUNDARY--
+};
+$content =~ s/\r\n/\n/g;
+$content =~ s/\n/\r\n/g;
+
+{
+    open my $in, '<', \$content;
+    my $req = Web::Request->new_from_env({
+        'psgi.input'   => $in,
+        CONTENT_LENGTH => length($content),
+        CONTENT_TYPE   => 'multipart/form-data; boundary=----BOUNDARY',
+        REQUEST_METHOD => 'POST',
+        SCRIPT_NAME    => '/',
+        SERVER_PORT    => 80,
+    });
+
+    my $uploads = $req->uploads;
+
+    ok !exists $uploads->{undef};
+
+    my @uploads = @{ $req->all_uploads->{test_upload_file} };
+
+    like slurp($uploads[0]), qr|^SHOGUN|;
+    like slurp($uploads[1]), qr|^SHOGUN|;
+    is slurp($req->uploads->{test_upload_file4}), 'SHOGUN4';
+
+    my $test_upload_file3 = $req->uploads->{test_upload_file3};
+    is slurp($test_upload_file3), 'SHOGUN3';
+
+    my @test_upload_file6 = @{ $req->all_uploads->{test_upload_file6} };
+    is slurp($test_upload_file6[0]), 'SHOGUN6';
+}
+
+done_testing;
+
+sub slurp {
+    my $up = shift;
+    open my $fh, "<", $up->tempname or die;
+    join '', <$fh>;
+}
diff --git a/t/multi_read.t b/t/multi_read.t
new file mode 100644
index 0000000..a4c8403
--- /dev/null
+++ b/t/multi_read.t
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+use Web::Request;
+
+my $app = sub {
+    my $env = shift;
+    my $req = Web::Request->new_from_env($env);
+    is $req->content, 'foo=bar';
+    is $req->content, 'foo=bar';
+
+    $req = Web::Request->new_from_env($env);
+    is $req->content, 'foo=bar';
+    $req->new_response(status => 200)->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+    my $res = $cb->(POST "/", { foo => "bar" });
+    ok $res->is_success;
+};
+
+done_testing;
diff --git a/t/new.t b/t/new.t
new file mode 100644
index 0000000..46aff08
--- /dev/null
+++ b/t/new.t
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Request;
+
+my $req = Web::Request->new_from_env({
+    REQUEST_METHOD    => 'GET',
+    SERVER_PROTOCOL   => 'HTTP/1.1',
+    SERVER_PORT       => 80,
+    SERVER_NAME       => 'example.com',
+    SCRIPT_NAME       => '/foo',
+    REMOTE_ADDR       => '127.0.0.1',
+    'psgi.version'    => [ 1, 0 ],
+    'psgi.input'      => undef,
+    'psgi.errors'     => undef,
+    'psgi.url_scheme' => 'http',
+});
+
+isa_ok($req, 'Web::Request');
+
+is($req->address, '127.0.0.1', 'address');
+is($req->method, 'GET', 'method');
+is($req->protocol, 'HTTP/1.1', 'protocol');
+is($req->uri, 'http://example.com/foo', 'uri');
+is($req->port, 80, 'port');
+is($req->scheme, 'http', 'url_scheme');
+
+done_testing;
diff --git a/t/parameters.t b/t/parameters.t
new file mode 100644
index 0000000..6f47739
--- /dev/null
+++ b/t/parameters.t
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+use Web::Request;
+
+my $app = sub {
+    my $req = Web::Request->new_from_env(shift);
+    my $b = $req->body_parameters;
+    is $b->{foo}, 'bar';
+    my $q = $req->query_parameters;
+    is $q->{bar}, 'baz';
+
+    is_deeply $req->parameters, { foo => 'bar', 'bar' => 'baz' };
+
+    $req->new_response(status => 200)->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+    $cb->(POST "/?bar=baz", { foo => "bar" });
+};
+
+done_testing;
diff --git a/t/params.t b/t/params.t
new file mode 100644
index 0000000..6d96fee
--- /dev/null
+++ b/t/params.t
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Request;
+
+my $req = Web::Request->new_from_env({ QUERY_STRING => "foo=bar" });
+is_deeply $req->parameters, { foo => "bar" };
+is $req->param('foo'), "bar";
+is_deeply [ keys %{ $req->parameters } ], [ 'foo' ];
+
+$req = Web::Request->new_from_env({ QUERY_STRING => "foo=bar&foo=baz" });
+is_deeply $req->parameters, { foo => "baz" };
+is $req->param('foo'), "baz";
+is_deeply $req->all_parameters->{foo}, [ qw(bar baz) ];
+is_deeply [ keys %{ $req->parameters } ], [ 'foo' ];
+
+$req = Web::Request->new_from_env({ QUERY_STRING => "foo=bar&foo=baz&bar=baz" });
+is_deeply $req->parameters, { foo => "baz", bar => "baz" };
+is_deeply $req->query_parameters, { foo => "baz", bar => "baz" };
+is $req->param('foo'), "baz";
+is_deeply $req->all_parameters->{foo}, [ qw(bar baz) ];
+is_deeply [ sort keys %{ $req->parameters } ], [ 'bar', 'foo' ];
+
+done_testing;
diff --git a/t/path_info.t b/t/path_info.t
new file mode 100644
index 0000000..bab50b9
--- /dev/null
+++ b/t/path_info.t
@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+use Plack::App::URLMap;
+use Web::Request;
+
+my $path_app = sub {
+    my $req = Web::Request->new_from_env(shift);
+    my $res = $req->new_response(status => 200);
+    $res->content_type('text/plain');
+    $res->body($req->path_info);
+    return $res->finalize;
+};
+
+my $app = Plack::App::URLMap->new;
+$app->map("/foo" => $path_app);
+$app->map("/" => $path_app);
+
+test_psgi app => $app->to_app, client => sub {
+    my $cb = shift;
+
+    my $res = $cb->(GET "http://localhost/foo");
+    is $res->content, '';
+
+    $res = $cb->(GET "http://localhost/foo/bar");
+    is $res->content, '/bar';
+
+    $res = $cb->(GET "http://localhost/xxx/yyy");
+    is $res->content, '/xxx/yyy';
+};
+
+done_testing;
diff --git a/t/path_info_escaped.t b/t/path_info_escaped.t
new file mode 100644
index 0000000..28e712c
--- /dev/null
+++ b/t/path_info_escaped.t
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use Data::Dumper;
+use HTTP::Request::Common;
+use Web::Request;
+
+my $path_app = sub {
+    my $req = Web::Request->new_from_env(shift);
+    my $res = $req->new_response(status => 200);
+    $res->content_type('text/plain');
+    $res->body('my ' . Dumper([ $req->uri, $req->parameters ]));
+    return $res->finalize;
+};
+
+test_psgi $path_app, sub {
+    my $cb = shift;
+
+    my $res = $cb->(GET "http://localhost/foo.bar-baz?a=b");
+    is_deeply eval($res->content), [ URI->new("http://localhost/foo.bar-baz?a=b"), { a => 'b' } ];
+
+    $res = $cb->(GET "http://localhost/foo%2fbar#ab");
+    is_deeply eval($res->content), [ URI->new("http://localhost/foo/bar"), {} ],
+        "%2f vs / can't be distinguished - that's alright";
+
+    $res = $cb->(GET "http://localhost/%23foo?a=b");
+    is_deeply eval($res->content), [ URI->new("http://localhost/%23foo?a=b"), { a => 'b' } ];
+};
+
+done_testing;
diff --git a/t/readbody.t b/t/readbody.t
new file mode 100644
index 0000000..44fa057
--- /dev/null
+++ b/t/readbody.t
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use Try::Tiny;
+use Web::Request;
+
+{
+    try {
+        my $data = 'a';
+        open my $input, "<", \$data;
+        my $req = Web::Request->new_from_env({
+            'psgi.input'   => $input,
+            CONTENT_LENGTH => 3,
+            CONTENT_TYPE   => 'application/octet-stream'
+        });
+        $req->body_parameters;
+    } catch {
+        like $_, qr/Bad Content-Length/;
+    }
+}
+
+done_testing;
diff --git a/t/request_uri.t b/t/request_uri.t
new file mode 100644
index 0000000..b3adcbd
--- /dev/null
+++ b/t/request_uri.t
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+use Web::Request;
+
+my $app = sub {
+    my $req = Web::Request->new_from_env(shift);
+    return [ 200, [], [ $req->request_uri ] ];
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+
+    my $res = $cb->(GET "http://localhost/foo%20bar");
+    is $res->content, '/foo%20bar';
+
+    $res = $cb->(GET "http://localhost:2020/FOO/bar,baz");
+    is $res->content, '/FOO/bar,baz';
+};
+
+done_testing;
diff --git a/t/upload-basename.t b/t/upload-basename.t
new file mode 100644
index 0000000..d13c489
--- /dev/null
+++ b/t/upload-basename.t
@@ -0,0 +1,13 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Request::Upload;
+
+my $upload = Web::Request::Upload->new(
+    filename => '/tmp/foo/bar/hoge.txt',
+);
+is $upload->basename, 'hoge.txt';
+
+done_testing;
diff --git a/t/upload-large.t b/t/upload-large.t
new file mode 100644
index 0000000..39e14a7
--- /dev/null
+++ b/t/upload-large.t
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+use Web::Request;
+
+my $file = "t/data/baybridge.jpg";
+
+my @backends = qw( Server MockHTTP );
+sub flip_backend { $Plack::Test::Impl = shift @backends }
+
+local $ENV{PLACK_SERVER} = "HTTP::Server::PSGI";
+
+my $app = sub {
+    my $req = Web::Request->new_from_env(shift);
+    is $req->uploads->{image}->size, -s $file;
+    is $req->uploads->{image}->content_type, 'image/jpeg';
+    is $req->uploads->{image}->basename, 'baybridge.jpg';
+    $req->new_response(status => 200)->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+    $cb->(POST "/", Content_Type => 'form-data', Content => [
+             image => [ $file ],
+         ]);
+} while flip_backend;
+
+done_testing;
+
diff --git a/t/upload.t b/t/upload.t
new file mode 100644
index 0000000..a024b3d
--- /dev/null
+++ b/t/upload.t
@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test;
+
+use HTTP::Request::Common;
+use Web::Request;
+
+my @temp_files = ();
+
+my $app = sub {
+    my $env = shift;
+    my $req = Web::Request->new_from_env($env);
+
+    isa_ok $req->uploads->{foo}, 'HASH';
+    is $req->uploads->{foo}->{filename}, 'foo2.txt';
+
+    my @files = $req->upload('foo');
+    is scalar(@files), 2;
+    is $files[0]->filename, 'foo1.txt';
+    is $files[1]->filename, 'foo2.txt';
+    ok -e $files[0]->tempname;
+
+    is join(', ', sort { $a cmp $b } $req->upload()), 'bar, foo';
+
+    for (qw(foo bar)) {
+        my $temp_file = $req->upload($_)->path;
+        ok -f $temp_file;
+        push @temp_files, $temp_file;
+    }
+
+    my $res = $req->new_response(status => 200);
+
+    undef $req; # Simulate when we instantiate Web::Request multiple times
+
+    # redo the test with the same $env
+    $req = Web::Request->new_from_env($env);
+    @files = $req->upload('foo');
+    is scalar(@files), 2;
+    is $files[0]->filename, 'foo1.txt';
+    ok -e $files[0]->tempname;
+
+    $res->finalize;
+};
+
+test_psgi $app, sub {
+    my $cb = shift;
+
+    $cb->(POST "/", Content_Type => 'form-data', Content => [
+             foo => [ "t/data/foo1.txt" ],
+             foo => [ "t/data/foo2.txt" ],
+             bar => [ "t/data/foo1.txt" ],
+         ]);
+};
+
+# Check if the temp files got cleaned up properly
+ok !-f $_ for @temp_files;
+
+done_testing;
+
diff --git a/t/uri.t b/t/uri.t
new file mode 100644
index 0000000..08aa584
--- /dev/null
+++ b/t/uri.t
@@ -0,0 +1,104 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Request;
+
+my @tests = (
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => "",
+      },
+      uri => 'http://example.com/',
+      parameters => {} },
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => "",
+        PATH_INFO => "/foo bar",
+      },
+      uri => 'http://example.com/foo%20bar',
+      parameters => {} },
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => '/test.c',
+      },
+      uri => 'http://example.com/test.c',
+      parameters => {} },
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => '/test.c',
+        PATH_INFO => '/info',
+      },
+      uri => 'http://example.com/test.c/info',
+      parameters => {} },
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => '/test',
+        QUERY_STRING => 'dynamic=daikuma',
+      },
+      uri => 'http://example.com/test?dynamic=daikuma',
+      parameters => { dynamic => 'daikuma' } },
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => '/exec/'
+      },
+      uri => 'http://example.com/exec/',
+      parameters => {} },
+    { add_env => {
+        SERVER_NAME => 'example.com'
+      },
+      uri => 'http://example.com/',
+      parameters => {} },
+    { add_env => {},
+      uri => 'http:///',
+      parameters => {} },
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => "",
+        QUERY_STRING => 'aco=tie'
+      },
+      uri => 'http://example.com/?aco=tie',
+      parameters => { aco => 'tie' } },
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => "",
+        QUERY_STRING => "foo_only"
+      },
+      uri => 'http://example.com/?foo_only',
+      parameters => { foo_only => '' } },
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => "",
+        QUERY_STRING => "foo&bar=baz"
+      },
+      uri => 'http://example.com/?foo&bar=baz',
+      parameters => { foo => '', bar => 'baz' } },
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => "",
+        QUERY_STRING => 0
+      },
+      uri => 'http://example.com/?0',
+      parameters => { 0 => '' } },
+    { add_env => {
+        HTTP_HOST => 'example.com',
+        SCRIPT_NAME => "/foo bar",
+        PATH_INFO => "/baz quux",
+      },
+      uri => 'http://example.com/foo%20bar/baz%20quux',
+      parameters => {} }
+);
+
+for my $block (@tests) {
+    my $env = {SERVER_PORT => 80};
+    while (my($key, $val) = each %{ $block->{add_env} || {} }) {
+        $env->{$key} = $val;
+    }
+    my $req = Web::Request->new_from_env($env);
+
+    is $req->uri, $block->{uri};
+    is_deeply $req->query_parameters, $block->{parameters};
+};
+
+done_testing;
diff --git a/t/uri_utf8.t b/t/uri_utf8.t
new file mode 100644
index 0000000..f10a745
--- /dev/null
+++ b/t/uri_utf8.t
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use utf8;
+use Test::More;
+
+use HTTP::Request;
+use Web::Request;
+
+my $path = "/Платежи";
+
+my $hreq = HTTP::Request->new(GET => "http://localhost" . $path);
+my $req = Web::Request->new_from_request($hreq);
+
+is $req->uri->path, '/%D0%9F%D0%BB%D0%B0%D1%82%D0%B5%D0%B6%D0%B8';
+
+done_testing;