From 14afca2d074d51d7b8fd5306b39e24e06c3a517a Mon Sep 17 00:00:00 2001 From: Aaron Trevena Date: Sun, 5 Nov 2006 17:41:36 +0000 Subject: [PATCH] fix to bug in Apache::MVC location handling git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@547 48953598-375a-da11-a14b-00016c27c3ee --- Changes | 1 + lib/Apache/MVC.pm | 14 +++++++++++--- lib/Maypole.pm | 2 -- 3 files changed, 12 insertions(+), 5 deletions(-) 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); -- 2.39.5