will be owned by this method.
my($self, $value) = @_;
die('too many calls to set_output')
if $self->has_keys('output');
die('not an IO::Handle, GLOB, or SCALAR reference')
unless ref($value) eq 'SCALAR' || ref($value) eq 'GLOB'
|| UNIVERSAL::isa($value, 'IO::Handle');
return shift->SUPER::set_output(@_);
}
sub _add_additional_http_headers {
# (self, Apache.Request) : undef
# Adds any additional http headers from the configuration.
my($self, $r) = @_;
return unless $_CFG->{additional_http_headers};
foreach my $pair (@{$_CFG->{additional_http_headers}}) {
my($key, $value) = @$pair;
$r->header_out($key => defined($r->header_out($key))
? $r->header_out($key) . "\r\n$key: $value"
: $value);
}
return;
}
sub _cookie_check {
my($self, $req, $r) = @_;
$self->set_cache_private
if $req->get('cookie')->header_out($req, $r);
return;
}
sub _error {
# (int, Apache.Request) : ApacheConstants.OK
# Workaround for apache in error mode. Sends the reply in line.
# This is due to a bug in apache which uses a form. See Req#21
my($code, $r) = @_;
#TODO: Older mod_perl versions had Apache::Constants bugs when not
# running in apache. If you're using 5.6.* or higher, you're
# probably using a newer apache. $^V was only defined after 5.005,
# so this check is good enough.
return $code
if defined($^V)
|| !exists($ENV{MOD_PERL})
|| $code == $_AC->OK;
$r->status($code);
$r->content_type('text/html');
_send_http_header(undef, undef, $r);
# make it look like apache's redirect
my($uri) = $r->uri;
# Ignore HEAD. There was an error, give the whole body
if ($code == $_AC->NOT_FOUND) {
$r->print(<<"EOF");
404 Not Found
Not Found
The requested URL $uri was not found on this server.
EOF
}
elsif ($code == $_AC->FORBIDDEN) {
$r->print(<<"EOF");
403 Forbidden
Forbidden
You don't have permission to access $uri
on this server.
EOF
}
else {
$r->print(<<"EOF");
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator,
webmaster\@@{[$r->server->server_hostname]}
and inform them of the time the error occurred,
and anything you might have done that may have
caused the error.
EOF
}
# This is a workaround in older Apache versions
return $_AC->OK;
}
sub _send_http_header {
# (HTTP.Reply, Agent.Request, Apache) : undef
# Sends the header, turning off keep alive (if necessary) and set cookie
# (if req)
my($self, $req, $r) = @_;
if ($req) {
$r->status($self->get('status'))
if $self->has_keys('status');
_cookie_check($self, $req, $r);
_add_additional_http_headers($self, $r);
my($h) = $self->unsafe_get('headers');
if ($h) {
foreach my $k (sort(keys(%$h))) {
$r->header_out($k, $h->{$k});
}
}
_trace($self->unsafe_get('status'), ' ', $h) if $_TRACE;
}
# Turn off KeepAlive if there are jobs. This is because IE doesn't
# cycle connections. It goes back to exactly the same one.
$r->header_out('Connection', 'close')
unless b_use('AgentJob.Dispatcher')->queue_is_empty;
$r->send_http_header;
return;
}
1;