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 f870c081d34b1cebfd384c0dfd02cfd833ccf2fd..085646905f7fc2e6a6e0c6e1dcadd04cd9beb831 100644 (file)
--- 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 e9caa396679f3f652745b9a6bdeb1432ed111b19..d5909bf897daabe7fafc60ad3daab36ae555b5d4 100644 (file)
--- 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 4f4008500aa0ad94a916c311453591ab6fa073e3..5e85cdfe59b45b23e7cf16905b45598a926593ba 100644 (file)
--- 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);