From 8b06651682da715d47e811441f73013033731c4b Mon Sep 17 00:00:00 2001
From: Arne Georg Gleditsch <argggh@lxr.linpro.no>
Date: Fri, 8 Feb 2008 01:17:53 +0100
Subject: Fidget around with the base url logic some more.

---
 lib/LXRng/Context.pm | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/lib/LXRng/Context.pm b/lib/LXRng/Context.pm
index 6611b46..f4865f0 100644
--- a/lib/LXRng/Context.pm
+++ b/lib/LXRng/Context.pm
@@ -41,7 +41,7 @@ sub new {
 	my $path = $ENV{'REQUEST_URI'};
 	$path =~ s/\?.*//;
 	$path =~ s,/+,/,g;
-	$$self{'req_url'} = $host.$path;
+	$$self{'req_base'} = $host.$ENV{'SCRIPT_NAME'};
 
 	foreach my $p ($args{'query'}->param) {
 	    $$self{'params'}{$p} = [$args{'query'}->param($p)];
@@ -61,6 +61,11 @@ sub new {
 		last;
 	    }
 	}
+	unless ($$self{'tree'}) {
+	    if ($ENV{'PATH_INFO'} =~ m,^/?([^/]+)/?(.*),) {
+		@$self{'tree', 'path'} = ($1, $2);
+	    }
+	}
 
 	$$self{'tree'} = $args{'query'}->param('tree') 
 	    if $args{'query'}->param('tree');
@@ -196,7 +201,7 @@ sub base_url {
 
     my $base = $self->config->{'base_url'};
     unless ($base) {
-	$base = $$self{'req_url'};
+	$base = $$self{'req_base'};
     }
 
     $base =~ s,/*$,/,;
-- 
cgit v1.2.3