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
    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
 
 
 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);
 }
 
     $self->ar($ar);
 }
 

-=item parse_location
+=item warn

 
 =cut
 
 
 =cut
 


@@ -116,7 +116,8 @@ sub warn {
   return;
 }
 
   return;
 }
 

-=item warn
+
+=item parse_location

 
 =cut
 
 
 =cut
 


@@ -131,13 +132,20 @@ sub parse_location {
     for (keys %headers) {
         $self->headers_in->set($_, $headers{$_});
     }
     for (keys %headers) {
         $self->headers_in->set($_, $headers{$_});
     }

+

     my $path = $self->ar->uri;
     my $loc  = $self->ar->location;
     my $path = $self->ar->uri;
     my $loc  = $self->ar->location;

+

     {
         no warnings 'uninitialized';
         $path .= '/' if $path eq $loc;
     {
         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;
     $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);
 
     $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 );
     $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;
 
 
     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);
     $self->table  || $self->table(shift @pi);
     $self->action || $self->action( shift @pi or 'index' );
     $self->args   || $self->args(\@pi);