diff options
author | Doug MacEachern <dougm@opengroup.org> | 1997-04-05 10:27:52 -0500 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1997-04-04 00:00:00 +0000 |
commit | a3ec56f7f3704c7c711a382a2e558eb572cef265 (patch) | |
tree | 343c03d0e060a8615045306e3bac40e6f3139c4e | |
parent | dcb2879abe1a588042098f71cb130a72def08afb (diff) | |
download | perl-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.pm | 16 |
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); |