summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDoug MacEachern <dougm@opengroup.org>1997-04-05 10:27:52 -0500
committerChip Salzenberg <chip@atlantic.net>1997-04-04 00:00:00 +0000
commita3ec56f7f3704c7c711a382a2e558eb572cef265 (patch)
tree343c03d0e060a8615045306e3bac40e6f3139c4e
parentdcb2879abe1a588042098f71cb130a72def08afb (diff)
downloadperl-a3ec56f7f3704c7c711a382a2e558eb572cef265.tar.gz
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
-rw-r--r--lib/CGI.pm16
1 files changed, 13 insertions, 3 deletions
diff --git a/lib/CGI.pm b/lib/CGI.pm
index 4651e138a3..19e1f018e5 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);