view release on metacpan or  search on metacpan

lib/Apache/ASP/Response.pm  view on Meta::CPAN

    $r->headers_out->set('Location', $location);
    $self->{Status} = 302;
    $r->status(302);

    # Always SendHeaders() immediately for a Redirect() ... only in a SoftRedirect
    # will execution continue.  Since we call SendHeaders here, instead of 
    # Flush() a Redirect() will still work even in a XMLSubs call where Flush is
    # trapped to Null()
    &SendHeaders($self);

    # if we have soft redirects, keep processing page after redirect
    if(&config($asp, 'SoftRedirect')) {
	$asp->Debug("redirect is soft, headers already sent");
    } else {
	# do we called End() or EndSoft() here?  As of v 2.33, End() will
	# just jump to the end of Execute(), so if we were in a XMLSubs
	# and called End() after doing a Clear() there would still be 
	# output the gets flushed out from before the XMLSubs, to prevent
	# this we clear the buffer now, and called EndSoft() in this case.
	# Finally we also call End() so we will jump out of the executing code.
	#
	&Clear($self);
	$self->{Ended} = 1; # just marked Ended so future EndSoft() cannot be called
#	&EndSoft($self);
	&End($self);
    }

    1;
}

sub SendHeaders {
    my $self = shift;
    my $r = $self->{r};
    my $asp = $self->{asp};
    my $dbg = $asp->{dbg};
    my $status = $self->{Status};

    return if $self->{header_done};
    $self->{header_done} = 1;

    $dbg && $asp->Debug('building headers');
    $r->status($status) if defined($status);

    # for command line script
    return if &config($asp, 'NoHeaders');

    if(defined $status and $status == 401) {
	$dbg && $asp->Debug("status 401, note basic auth failure realm ".$r->auth_name);

	# we can't send out headers, and let Apache use the 401 error doc
	# But this is fine, once authorization is OK, then the headers
	# will go out correctly, so things like sessions will work fine.
	$r->note_basic_auth_failure;
	return;
    } else {
	$dbg && defined $status && $self->{asp}->Debug("status $status");
    }

    if(defined $self->{Charset}) {
	$r->content_type($self->{ContentType}.'; charset='.$self->{Charset});
    } else {
	$r->content_type($self->{ContentType}); # add content-type
    }

    if(%{$self->{'Cookies'}}) {
	&AddCookieHeaders($self);     # do cookies
    }

    # do the expiration time
    if(defined $self->{Expires}) {
	my $ttl = $self->{Expires};
	$r->headers_out->set('Expires', &Apache::ASP::Date::time2str(time()+$ttl));
	$dbg && $self->{asp}->Debug("expires in $self->{Expires}");
    } elsif(defined $self->{ExpiresAbsolute}) {
	my $date = $self->{ExpiresAbsolute};
	my $time = &Apache::ASP::Date::str2time($date);
	if(defined $time) {
	    $r->headers_out->set('Expires', &Apache::ASP::Date::time2str($time));
	} else {
	    confess("Response->ExpiresAbsolute(): date format $date not accepted");
	}
    }

    # do the Cache-Control header
    $r->headers_out->set('Cache-Control', $self->{CacheControl});
    
    # do PICS header
    defined($self->{PICS}) && $r->headers_out->set('PICS-Label', $self->{PICS});
    
    # don't send headers with filtering, since filter will do this for
    # all the modules once
    # doug sanctioned this one
    unless($r->headers_out->get("Content-type")) {
	# if filtering, we don't send out a header from ASP
	# this means that Filtered scripts can use CGI headers
	# we order the test this way in case Ken comes on
	# board with setting header_out, in which case the test 
	# will fail early       
	if(! $asp->{filter} && (! defined $status or $status >= 200 && $status < 400)) {
	    $dbg && $asp->Debug("sending cgi headers");
	    if(defined $self->{header_buffer}) {
		# we have taken in cgi headers
		$r->send_cgi_header($self->{header_buffer} . "\n");
		$self->{header_buffer} = undef;
	    } else {
		unless($Apache::ASP::ModPerl2) {
		    # don't need this for mod_perl2 it seems from Apache::compat
		    $r->send_http_header();
		}
	    }
	}
    }

    1;
}

# do cookies, try our best to emulate cookie collections
sub AddCookieHeaders {
    my $self = shift;
    my $cookies = $self->{'Cookies'};