From: Doug MacEachern <dougm@opengroup.org>
Date: Sat, 5 Apr 1997 15:27:52 +0000 (-0500)
Subject: CGI->redirect patch
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3ec56f7f3704c7c711a382a2e558eb572cef265;p=p5sagit%2Fp5-mst-13.2.git

CGI->redirect patch

Mike Stok <mike@stok.co.uk> wrote:

> I am having an odd problem with a redirect using apacha & mod perl.
>
> #!/usr/local/register/bin/perl -w
>
> use CGI::Switch;
>
> my $q = new CGI::Switch;
>
> $q->print ($q->redirect (-uri => 'http://vrooom.nis.newscorp.com:8008/',
>                          -nph => 1));
>
> as a "regular" cgi script works OK, but under mod_perl gets a "document
> contains no data" error out of the browser.  When under mod_perl I have
> the code in .../register/code/boing ans the httpd.conf file says
[...]
> Is there some simple mistake I'm making?  I'm using perl 5.003_95 and
> mod_perl 0.95_02 with apache 1.2b7 ... changing the versions fills me with
> terror as I'm < 24 hours away from a product roll out and the code works
> OK as CGI.

nuts, I should have done something about this a while ago.  See, CGI
reads your scripts output, scanning headers and such.  mod_perl does
not.  This patch should makes things behave as expected.

p5p-msgid: 199704041732.MAA05896@postman.osf.org
private-msgid: 199704051527.KAA11280@postman.osf.org
---

diff --git a/lib/CGI.pm b/lib/CGI.pm
index 4651e13..19e1f01 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -990,11 +990,21 @@ sub redirect {
     $url = $url || $self->self_url;
     my(@o);
     foreach (@other) { push(@o,split("=")); }
-    push(@o,
+    if($MOD_PERL or exists $self->{'.req'}) {
+	my $r = $self->{'.req'} || Apache->request;
+	$r->header_out(Location => $url);
+	$r->err_header_out(Location => $url);
+	$r->status(302);
+	return;
+    }
+    else {
+	push(@o,
 	 '-Status'=>'302 Found',
 	 '-Location'=>$url,
-	 '-URI'=>$url,
-	 '-nph'=>($nph||$NPH));
+	 '-nph'=>($nph||$NPH),
+	);
+    }
+    push(@o, '-URI'=>$url);
     push(@o,'-Target'=>$target) if $target;
     push(@o,'-Cookie'=>$cookie) if $cookie;
     return $self->header(@o);