From: Aaron Trevena <aaron.trevena@gmail.com>
Date: Sun, 5 Nov 2006 17:41:36 +0000 (+0000)
Subject: fix to bug in Apache::MVC location handling
X-Git-Tag: 2.12~27
X-Git-Url: https://git.decadent.org.uk/gitweb/?a=commitdiff_plain;h=14afca2d074d51d7b8fd5306b39e24e06c3a517a;p=maypole.git

fix to bug in Apache::MVC location handling

git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@547 48953598-375a-da11-a14b-00016c27c3ee
---

diff --git a/Changes b/Changes
index f870c08..0856469 100644
--- a/Changes
+++ b/Changes
@@ -18,6 +18,7 @@ For information about current developments and future releases, see:
    made DFV and FromCGI warn instead of die on unexpected cgi params
    added CGI params to TT error template
    small improvements to some factory templates
+   fix to path handling in mod_perl when location ends in /
 
 2.11 Mon 31 July 2006
 
diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index e9caa39..d5909bf 100644
--- a/lib/Apache/MVC.pm
+++ b/lib/Apache/MVC.pm
@@ -101,7 +101,7 @@ sub get_request {
     $self->ar($ar);
 }
 
-=item parse_location
+=item warn
 
 =cut
 
@@ -116,7 +116,8 @@ sub warn {
   return;
 }
 
-=item warn
+
+=item parse_location
 
 =cut
 
@@ -131,13 +132,20 @@ sub parse_location {
     for (keys %headers) {
         $self->headers_in->set($_, $headers{$_});
     }
+
     my $path = $self->ar->uri;
     my $loc  = $self->ar->location;
+
     {
         no warnings 'uninitialized';
         $path .= '/' if $path eq $loc;
-        $path =~ s/^($loc)?\///;
+	if ($loc =~ /\/$/) {
+	  $path =~ s/^($loc)?//;
+	} else {
+	  $path =~ s/^($loc)?\///;
+	}
     }
+
     $self->path($path);
     $self->parse_path;
     $self->parse_args;
diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index 4f40085..5e85cdf 100644
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -476,7 +476,6 @@ sub component {
 
     $self->get_user;
     my $url = URI->new($path);
-    warn "path : $path\n";
     $self->{path} = $url->path;
     $self->parse_path;
     $self->params( $url->query_form_hash );
@@ -990,7 +989,6 @@ sub parse_path
 
     my @pi = grep {length} split '/', $self->path;
 
-
     $self->table  || $self->table(shift @pi);
     $self->action || $self->action( shift @pi or 'index' );
     $self->args   || $self->args(\@pi);