Permalink
Browse files

fix uri_for

  • Loading branch information...
1 parent f97ca58 commit 7a8ff31ca0b9e19c164a128bc8e0ac2111f19f81 @ichirin2501 ichirin2501 committed Oct 12, 2012
Showing with 96 additions and 1 deletion.
  1. +4 −1 lib/Ark/Context.pm
  2. +92 −0 t/context_uri_for.t
View
@@ -272,9 +272,12 @@ sub uri_for {
my ($self, @path) = @_;
my $params = ref $path[-1] eq 'HASH' ? pop @path : {};
+ my $base = $self->req->base;
+ $base =~ s!/*$!!;
+
(my $path = join '/', @path) =~ s!/{2,}!/!g;
$path =~ s!^/+!!;
- my $uri = URI::WithBase->new($path, $self->req->base);
+ my $uri = URI::WithBase->new($path, $base . '/');
$uri->query_form($params);
$uri->abs;
View
@@ -0,0 +1,92 @@
+package MyApp;
+use Ark;
+
+package MyApp::Controller::Root;
+use Ark 'Controller';
+
+sub default : Path('/') {
+ my ( $self, $c ) = @_;
+ $c->response->body( $c->uri_for('/root') );
+}
+
+sub admin : Path('/admin') {
+ my ( $self, $c ) = @_;
+ $c->response->body( $c->uri_for('/admin') );
+}
+
+
+package main;
+use strict;
+use warnings;
+use Plack::Builder;
+use Test::More;
+use Plack::Test;
+$Plack::Test::Impl = "MockHTTP";
+
+my $app = MyApp->new;
+$app->setup;
+
+my $root = builder {
+ my $env = shift;
+ mount '/' => $app->handler;
+};
+
+my $admin = builder {
+ my $env = shift;
+ mount '/admin' => $app->handler;
+};
+
+my $admin_slash = builder {
+ my $env = shift;
+ mount '/admin/' => $app->handler;
+};
+
+
+test_psgi
+ app => $root,
+ client => sub {
+ my $cb = shift;
+ my $req = HTTP::Request->new( GET => "http://localhost/" );
+ my $res = $cb->($req);
+ is $res->content, 'http://localhost/root';
+ is $res->code, 200;
+
+ $req = HTTP::Request->new( GET => "http://localhost/admin" );
+ $res = $cb->($req);
+ is $res->content, 'http://localhost/admin';
+ is $res->code, 200;
+
+ };
+
+test_psgi
+ app => $admin,
+ client => sub {
+ my $cb = shift;
+ my $req = HTTP::Request->new( GET => "http://localhost/admin" );
+ my $res = $cb->($req);
+ is $res->content, 'http://localhost/admin/root';
+ is $res->code, 200;
+
+ $req = HTTP::Request->new( GET => "http://localhost/admin/admin" );
+ $res = $cb->($req);
+ is $res->content, 'http://localhost/admin/admin';
+ is $res->code, 200;
+
+ };
+
+test_psgi
+ app => $admin_slash,
+ client => sub {
+ my $cb = shift;
+ my $req = HTTP::Request->new( GET => "http://localhost/admin" );
+ my $res = $cb->($req);
+ is $res->content, 'http://localhost/admin/root';
+ is $res->code, 200;
+
+ $req = HTTP::Request->new( GET => "http://localhost/admin/admin" );
+ $res = $cb->($req);
+ is $res->content, 'http://localhost/admin/admin';
+ is $res->code, 200;
+ };
+
+done_testing;

0 comments on commit 7a8ff31

Please sign in to comment.