[Catalyst-commits] r6268 - / trunk/Catalyst-Runtime/lib/Catalyst

[zarquon at dev.catalyst.perl.org]

Author: zarquon
Date: 2007-04-04 01:42:00 +0100 (Wed, 04 Apr 2007)
New Revision: 6268

Modified:
   /
   trunk/Catalyst-Runtime/lib/Catalyst/Test.pm
Log:
 r9742 at zaphod:  kd | 2007-03-12 15:55:25 +1100
 fixed problem with overlapping server path and request path when testing on a non-root server



Property changes on: 
___________________________________________________________________
Name: svk:merge
   - 1b129c88-ebf4-0310-add9-f09427935aba:/local/catalyst:4278
1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst:9741
3b9770f9-e80c-0410-a7de-cd203d167417:/local/catalyst:3514
dd8ad9ea-0304-0410-a433-df5f223e7bc0:/local/Catalyst:6909
   + 1b129c88-ebf4-0310-add9-f09427935aba:/local/catalyst:4278
1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst:9742
3b9770f9-e80c-0410-a7de-cd203d167417:/local/catalyst:3514
dd8ad9ea-0304-0410-a433-df5f223e7bc0:/local/Catalyst:6909

Modified: trunk/Catalyst-Runtime/lib/Catalyst/Test.pm
===================================================================
--- trunk/Catalyst-Runtime/lib/Catalyst/Test.pm	2007-04-04 00:41:39 UTC (rev 6267)
+++ trunk/Catalyst-Runtime/lib/Catalyst/Test.pm	2007-04-04 00:42:00 UTC (rev 6268)
@@ -136,6 +136,21 @@
 
     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) {
+        my @sp = split '/', $server->path;
+        my @rp = split '/', $request->uri->path;
+        shift @sp;shift @rp; # leading /
+        if (@rp) {
+            foreach my $sp (@sp) {
+                shift @rp if $sp eq $rp[0];
+            }
+        }
+        $request->uri->path(join '/', @rp);
     }
 
     # the request path needs to be sanitised if $server is using a