From: Aaron Trevena Date: Fri, 1 Jun 2007 12:39:38 +0000 (+0000) Subject: fix to Apache::MVC redirect_request X-Git-Tag: 2.12~8 X-Git-Url: https://git.decadent.org.uk/gitweb/?a=commitdiff_plain;h=8bee7ab27f76f2b3e8a65113ded4d439ec4949fe;p=maypole.git fix to Apache::MVC redirect_request git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@566 48953598-375a-da11-a14b-00016c27c3ee --- 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