From 8bee7ab27f76f2b3e8a65113ded4d439ec4949fe Mon Sep 17 00:00:00 2001 From: Aaron Trevena Date: Fri, 1 Jun 2007 12:39:38 +0000 Subject: [PATCH] fix to Apache::MVC redirect_request git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@566 48953598-375a-da11-a14b-00016c27c3ee --- lib/Apache/MVC.pm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm index 6f85d6e..696ab84 100644 --- a/lib/Apache/MVC.pm +++ b/lib/Apache/MVC.pm @@ -185,8 +185,7 @@ can only be combined with status. =cut -sub redirect_request -{ +sub redirect_request { my $r = shift; my $redirect_url = $_[0]; my $status = $MODPERL2 ? eval 'Apache2::Const::REDIRECT;' : @@ -199,7 +198,11 @@ sub redirect_request my $path = $args{path} || $r->path; my $host = $args{domain} || $r->ar->hostname; my $protocol = $args{protocol} || $r->get_protocol; - $redirect_url = "${protocol}://${host}/${path}"; + + $redirect_url = URI->new; + $redirect_url->scheme($protocol); + $redirect_url->host($host); + $redirect_url->path($path); } $status = $args{status} if ($args{status}); } @@ -209,6 +212,7 @@ sub redirect_request return OK; } + =item get_protocol =cut -- 2.39.2