HTTP::Daemon::Threaded::Socket

package HTTP::Daemon::Threaded::Socket;

use HTTP::Status;
use HTTP::Daemon;
use HTTP::Date qw(time2str);
use LWP::MediaTypes qw(guess_media_type);
use base qw(HTTP::Daemon::ClientConn);

use strict;
use warnings;

our $VERSION = '0.91';

our $CRLF = "\015\012";   # "\r\n" is not portable

sub handleSocketEvent {
	my $self = shift;
	warn "Unimplemented handleSocketEvent() method!\n",
	return undef
		unless exists ${*$self}{_httpd_context};
	return ${*$self}{_httpd_context}->handleSocketEvent($self, @_);
}

sub close {
	my $self = shift;
#
#	now support IO::Select removal
#
	${*$self}{_select_context}->removeAll($self)
		if exists ${*$self}{_select_context};
	$self->SUPER::close();
	delete ${*$self}{_httpd_context};
	delete ${*$self}{_select_context};
	return 1;
}
#
#	our method additions to manage
#	context objects
#

sub setContext {
	my ($self, $context, $getpeer) = @_;
	${*$self}{_httpd_context} = $context;
	if ($getpeer) {
		my ($port, $addr) = sockaddr_in(getpeername(*$self));
		${*$self}{_peer_addr} = inet_ntoa($addr);
	}
	return $self;
}

sub getContext {
	my $self = shift;
	return ${*$self}{_httpd_context};
}

sub removeContext {
	my $self = shift;
	delete ${*$self}{_httpd_context};
	delete ${*$self}{_peer_addr};
	return $self;
}
#
#	because of a catch-22 situation w/ IO::Select(),
#	we have to register the selectors here, so we
#	can remove ourselves on close()
#	NOTE: we assume the selector is a HTTP::Daemon::Threaded::IOSelector
#

sub setSelector {
	my $self = shift;
	${*$self}{_select_context} = shift;
	return $self;
}

sub getSelector {
	my $self = shift;
	return ${*$self}{_select_context};
}

sub removeSelector {
	my $self = shift;
	delete ${*$self}{_select_context};
	return $self;
}
########################################
#
#	provide Selector i/fs thru ourselves
#	to simplify the code
#
########################################

sub addRead {
	my $self = shift;
	return ${*$self}{_select_context}->addRead($self);
}

sub addWrite {
	my $self = shift;
	return ${*$self}{_select_context}->addWrite($self);
}

sub addExcept {
	my $self = shift;
	return ${*$self}{_select_context}->addExcept($self);
}

sub addNoWrite {
	my $self = shift;
	return ${*$self}{_select_context}->addNoWrite($self);
}

sub addAll {
	my $self = shift;
	return ${*$self}{_select_context}->addAll($self);
}

sub removeRead {
	my $self = shift;
	return ${*$self}{_select_context}->removeRead($self);
}

sub removeWrite {
	my $self = shift;
	return ${*$self}{_select_context}->removeWrite($self);
}

sub removeExcept {
	my $self = shift;
	return ${*$self}{_select_context}->removeExcept($self);
}

sub removeNoWrite {
	my $self = shift;
	return ${*$self}{_select_context}->removeNoWrite($self);
}

sub removeAll {
	my $self = shift;
	return ${*$self}{_select_context}->removeAll($self);
}

sub send_file_header
{
	my ($self, $file) = @_;

	return $self->send_error(RC_NOT_IMPLEMENTED)
		if (-d $file);

	return $self->send_error(RC_NOT_FOUND)
		unless (-f _);

	my $f;
	sysopen($f, $file, 0) or
		return $self->send_error(RC_FORBIDDEN);

	binmode($f);
	my ($ct, $ce) = guess_media_type($file);
	my ($size, $mtime) = (stat _)[7,9];
	${*$self}{_httpd_context}->logRequest(${*$self}{_peer_addr}, RC_OK, $size);

	$self->send_basic_header;
	print $self "Content-Type: $ct$CRLF";
	print $self "Content-Encoding: $ce$CRLF"
		if $ce;
	print $self "Content-Length: $size$CRLF"
		if $size;
	print $self "Last-Modified: ", time2str($mtime), "$CRLF"
		if $mtime;
	print $self $CRLF;
    $self->flush();
	return RC_OK;
}

sub send_file_response
{
	my ($self, $file) = @_;

	return $self->send_error(RC_NOT_IMPLEMENTED)
		if (-d $file);

	return $self->send_error(RC_NOT_FOUND)
		unless (-f _);

	my $f;
	sysopen($f, $file, 0) or
		return $self->send_error(RC_FORBIDDEN);

	binmode($f);
	my ($ct, $ce) = guess_media_type($file);
	my ($size, $mtime) = (stat _)[7,9];
	${*$self}{_httpd_context}->logRequest(${*$self}{_peer_addr}, RC_OK, $size);

	$self->send_basic_header;
	print $self "Content-Type: $ct$CRLF";
	print $self "Content-Encoding: $ce$CRLF"
		if $ce;
	print $self "Content-Length: $size$CRLF"
		if $size;
	print $self "Last-Modified: ", time2str($mtime), "$CRLF"
		if $mtime;
	print $self $CRLF;
	$self->send_file($f);
    $self->flush();
	return RC_OK;
}

sub daemon {
	my $self = shift;
	return ${*$self}{_httpd_context};
}

sub send_response
{
    my $self = shift;
    my $res = shift;

	$res ||= RC_OK,
	$res = HTTP::Response->new($res, @_)
	    unless (ref $res);

	${*$self}{_httpd_context}->logRequest(
		${*$self}{_peer_addr}, $res->code(), $res->content_length());
    $self->SUPER::send_response($res, @_);
    $self->flush();
    return $res->code();
}

sub send_error
{
    my $self = shift;
    my $status = shift;
    $status ||= RC_BAD_REQUEST;
	${*$self}{_httpd_context}->logRequest(${*$self}{_peer_addr}, $status);
    $self->SUPER::send_error($status, @_);
    $self->flush();
    return $status
}

sub send_redirect
{
    my $self = shift;
    my ($loc, $status, $content) = @_;
    $status ||= RC_MOVED_PERMANENTLY;
	${*$self}{_httpd_context}->logRequest(${*$self}{_peer_addr}, $status);
    return $self->SUPER::send_redirect($loc, $status, $content);
}

sub get_request
{
    my $self = shift;
    my $req = $self->SUPER::get_request(@_);
	${*$self}{_httpd_context}->scanForLogging($req)
		if $req;
	return $req;
}

1;