[Catalyst-commits] r6225 - trunk/Catalyst-Runtime/lib/Catalyst
andyg at dev.catalyst.perl.org
andyg at dev.catalyst.perl.org
Wed Mar 28 22:25:39 GMT 2007
Author: andyg
Date: 2007-03-28 22:25:38 +0100 (Wed, 28 Mar 2007)
New Revision: 6225
Modified:
trunk/Catalyst-Runtime/lib/Catalyst/Test.pm
trunk/Catalyst-Runtime/lib/Catalyst/Utils.pm
Log:
Fix to C::Test to allow proper testing of remote URLs when the trailing slash is removed
Modified: trunk/Catalyst-Runtime/lib/Catalyst/Test.pm
===================================================================
--- trunk/Catalyst-Runtime/lib/Catalyst/Test.pm 2007-03-28 20:13:53 UTC (rev 6224)
+++ trunk/Catalyst-Runtime/lib/Catalyst/Test.pm 2007-03-28 21:25:38 UTC (rev 6225)
@@ -136,12 +136,16 @@
if ( $server->path =~ m|^(.+)?/$| ) {
$server->path("$1"); # need to be quoted
- }
+ }
# the request path needs to be sanitised if $server is using a
# non-root path due to potential overlap between request path and
# response path.
if ($server->path) {
+ # If request path is '/', we have to add a trailing slash to the
+ # final request URI
+ my $add_trailing = $request->uri->path eq '/';
+
my @sp = split '/', $server->path;
my @rp = split '/', $request->uri->path;
shift @sp;shift @rp; # leading /
@@ -151,6 +155,10 @@
}
}
$request->uri->path(join '/', @rp);
+
+ if ( $add_trailing ) {
+ $request->uri->path( $request->uri->path . '/' );
+ }
}
$request->uri->scheme( $server->scheme );
Modified: trunk/Catalyst-Runtime/lib/Catalyst/Utils.pm
===================================================================
--- trunk/Catalyst-Runtime/lib/Catalyst/Utils.pm 2007-03-28 20:13:53 UTC (rev 6224)
+++ trunk/Catalyst-Runtime/lib/Catalyst/Utils.pm 2007-03-28 21:25:38 UTC (rev 6225)
@@ -220,10 +220,10 @@
my $request = shift;
unless ( ref $request ) {
if ( $request =~ m/^http/i ) {
- $request = URI->new($request)->canonical;
+ $request = URI->new($request);
}
else {
- $request = URI->new( 'http://localhost' . $request )->canonical;
+ $request = URI->new( 'http://localhost' . $request );
}
}
unless ( ref $request eq 'HTTP::Request' ) {
More information about the Catalyst-commits
mailing list