HTTP::Daemon::Threaded::Listener

package HTTP::Daemon::Threaded::Listener;

use Socket;
use Sys::Hostname;
use threads;
use threads::shared;
use HTTP::Daemon::Threaded::Socket;
use HTTP::Daemon::Threaded::WebClient;
use HTTP::Daemon::Threaded::IOSelector;
use HTTP::Daemon::Threaded::Logable;
use Thread::Apartment::MuxServer;

use base qw(HTTP::Daemon::Threaded::Logable Thread::Apartment::MuxServer);

use strict;
use warnings;

our $VERSION = '0.91';

use constant HTTPD_INTERVAL => 0.5;

sub new {
	my ($class, %args) = @_;

	$args{SelectInterval} = HTTPD_INTERVAL
		unless $args{SelectInterval};

	my $self = { %args, _status => 'starting' };
	bless $self, $class;
#
#	setup our proxy version
#
	$self->set_client(delete $self->{AptTAC});
#
#	open our listener
#
	$self->{Port} = $args{Port} = 80
		unless exists $args{Port};
	$self->{_fd} = HTTP::Daemon::Threaded::Socket->new(
		LocalPort => $args{Port},
		Proto => 'tcp',
		Listen => 10);
	$self->logError("Cannot get listener for Web Server: $!"),
	$@ = "Cannot get listener for Web Server: $!",
	return undef
		unless $self->{_fd};
#
#	register ourselves with it
#	(for single threaded mode)
#
	$self->{_fd}->setContext($self);

	$self->logInfo("Created listener\n");
#
#	create a selector
#

	$self->{_sktsel} = HTTP::Daemon::Threaded::IOSelector->new($args{SelectInterval});
	$self->{_sktsel}->addNoWrite($self->{_fd});
#
#	create request handler pool
#
	my @avail_clients : shared = ();
	$self->{_avail_clients} = \@avail_clients;
	my @webclients = (undef);
	$self->{_clients} = \@webclients;
#
#	update the args
#
	$self->{LogLevel} = $args{LogLevel} = 1
		unless exists $args{LogLevel};
	delete $args{MaxClients};
#
#	normalize docroot if needed
#
	$args{DocRoot} .= '/'
		if (defined $args{DocRoot}) && (substr($args{DocRoot}, -1, 1) ne '/');

    my $url = "http://";
    my $addr = $self->{_fd}->sockaddr;
 	$url .= (!$addr || $addr eq INADDR_ANY) ?
 		lc Sys::Hostname::hostname() :
 		(gethostbyaddr($addr, AF_INET) || inet_ntoa($addr));
    my $port = $self->{_fd}->sockport;
    $url .= ":$args{Port}"
    	unless ($args{Port} == 80);
    $args{URL} = $url . '/';
	delete $args{Port};

	$args{ProductTokens} = "HTTP::Daemon::Threaded/$VERSION"
		unless $args{ProductTokens};

	$args{HTTPD} = $self->get_client();
	$args{AptClass} = 'HTTP::Daemon::Threaded::WebClient';
	$args{FreeList} = \@avail_clients;
#
#	note that this inactivity timer may be overridden by
#	any Session object's timeout
#
	$self->{InactivityTimer} = $args{InactivityTimer} = 10 * 60
		unless exists $args{InactivityTimer};

	foreach (1..$self->{MaxClients}) {
		$args{ID} = $_;
		push @webclients, Thread::Apartment->new(%args);

		pop @webclients,
		$@ = 'Unable to create a WebClient instance.',
		$self->logWarning('Unable to create a WebClient instance.'),
		return undef
			unless $webclients[-1];
		push @{$self->{_avail_clients}}, $_;
		$self->logInfo("Created WebClient\n");
	}

	$self->{_status} = 'running';
	return $self;
}

sub run {
	my $self = shift;

	while (1) {
		if ($self->{_sktsel}) {
#
#	HTTP::Daemon::Threaded::IOSelector does the heavy lifting
#
			my $elapsed = $self->{_sktsel}->select();
			print STDERR "Long select!!! $elapsed\n"
				if ($elapsed >= 1);
		}
		else {
			select(undef, undef, undef, 0.1);
		}

		return undef
			unless $self->handle_method_requests();
#
#	shutdown may remove our selector
#
#		last unless $self->{_sktsel};
	}

	return undef;
}

sub status {
#print "Returning status ", $_[0]->{_status}, "\n";
	return $_[0]->{_status};
}

sub get_simplex_methods {
	return {
		close => 1,
		setLogLevel => 1,
		setListenInterval => 1,
	};
}

sub close {
	my $self = shift;

	$self->logInfo("shutdown requested\n");

	delete $self->{_sktsel};

	$self->{_fd}->close(),
	delete $self->{_fd}
		if $self->{_fd};
#
#	queue stops first, then join
#
	if ($self->{_clients}) {
		map { $_->stop() if $_; } @{$self->{_clients}};
		map { $_->join() if $_; } @{$self->{_clients}};
	}
	$self->{_status} = 'stopped';
	return 1;
}

sub getSocket { return shift->{_fd}; }

sub handleSocketEvent {
	my $self = shift;

	$self->logInfo('Got web connection request.');
#
#	client must accept(): must make this duplex, so we don't keep
#	pinging the listener
#
	my $skt = $self->{_fd}->accept();
	return 1 unless $skt;

	my $client = $self->_get_client();
	$skt->close(),
	return 1
		unless $client;
#
#	this waits for client...
#
	$client->acceptConnection($skt->fileno());

	return 1;
}
#
#	do we need to close the file here ?
#	maybe we should just let the clients accept() ?
#

sub handleSocketError {
	my $self = shift;

	$self->logWarn("Problem with web listener.");
	warn "Problem with web listener, exitting...\n";
	return undef;
}

sub _get_client {
	my $self = shift;
	my $client;
	{
		lock(@{$self->{_avail_clients}});
		$client = pop @{$self->{_avail_clients}};
	}
	return $client ? $self->{_clients}[$client] : undef;
}

sub setLogLevel {
	my ($self, $level) = @_;

	$_->setLogLevel($level)
		foreach (@{$self->{_clients}});
	$self->{LogLevel} = $level;
	return 1;
}

sub setListenInterval {
	$_[0]->{_sktsel}->setTimeout($_[1]);
}

sub getListenInterval {
	return $_[0]->{_sktsel}->getTimeout();
}

1;