#/**
# Web network listener: accepts network connections, and routes
# them to WebClient objects to handle the web requests. Creates and maintains
# a pool of WebClient objects.
#<p>
# A threads::shared array is shared between this object and the WebClient
# objects so that WebClients can return themselves to the free list quickly;
# a future release may convert the freelist to a full object, in the event
# the allocate/free methods require a more complex process.
# <p>
# Copyright&copy 2006, Dean Arnold, Presicient Corp., USA<br>
# All rights reserved.
# <p>
# Licensed under the Academic Free License version 2.1, as specified in the
# License.txt file included in this software package, or at
# <a href='http://www.opensource.org/licenses/afl-2.1.php'>OpenSource.org</a>.
#
# @author D. Arnold
# @since 2006-08-21
# @self	$self
#
#*/
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.90';

use constant HTTPD_INTERVAL => 0.5;

#/**
# Constructor. Opens the HTTPD listener socket and creates
# its selector. Creates a pool of HTTP::Daemon::Threaded::WebClient
# apartment threaded objects, based on the specified MaxClient
# parameter.
# <p>
# Note that the following parameters are recognized by
# HTTP::Daemon::Threaded and/or HTTP::Daemon::Threaded::WebClient, but
# applications may supply additional parameter key/value pairs
# which will be provided to the constructor for any specified
# HTTP::Daemon::Threaded::ContentParams class.
#
# @param AptTimeout		<i>(optional)</i> Thread::Apartment proxy return timeout
# @param Port			<i>(optional)</i> TCP listen port; default 80.
# @param MaxClients		<i>(optional)</i> max number of client handlers to spawn;
#						default 5
# @param LogLevel		<i>(optional)</i> logging level; 1 => errors only; 2 => errors and warnings only; 3 => errors, warnings,
#						and info messages; default 1
# @param EventLogger <i>(optional)</i> Instance of a HTTP::Daemon::Threaded::Logger to receive
#					event notifications (except for web requests)
# @param WebLogger	<i>(optional)</i> Instance of a HTTP::Daemon::Threaded::Logger to receive
#					web request notifications
# @param Handlers		<i>(required)</i> URI handler map; arrayref mapping URI regex's to handler package names
# @param UserAuth		<i>(optional)</i> instance of a subclass of HTTP::Daemon::Threaded::Auth <i>(not yet supported)</i>
# @param SessionCache	<i>(optional)</i> instance of a subclass of HTTP::Daemon::Threaded::SessionCache
#						to be used to create/manage sessions
# @param InactivityTimer <i>(optional)</i> number of seconds a WebClient waits before disconnecting
#						an idle connection; default 10 minutes
# @param ContentParams  <i>(optional)</i> name of concrete implementation of HTTP::Daemon::Threaded::ContentParams
# @param DocRoot		<i>(optional)</i> root directory for default file based content handler
# @param ProductTokens	<i>(optional)</i> product token string to return to client; default
#						is 'HTTP::Daemon::Threaded/<version>'
# @param MediaTypes		<i>(optional)</i> hashref mapping 'Content-Type' specifications to
#						file qualifier strings. Values may be either a single string literal, or
# @param SelectInterval	<i>(optional)</i> seconds to wait in select()'s on sockets. May be fractional; default 0.5
#
# @return		HTTP::Daemon::Threaded object
#*/
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;
}

#/**
# Thread::Apartment::MuxServer::run() implementation.
#
# @return		1
#*/
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};
}

#/**
# Overrides Thread::Apartment::Server::get_simplex_methods()
#
# @return		hashref of simplex method names
#*/
sub get_simplex_methods {
	return {
		close => 1,
		setLogLevel => 1,
		setListenInterval => 1,
	};
}

#/**
# Closes the listen socket and stops all the WebClient
# threads.
#
# @simplex
# @return		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;
}

#/**
# Return the listener socket.
#
# @return		HTTP::Daemon::Threaded::Socket listen socket object
#*/
sub getSocket { return shift->{_fd}; }
#/**
# Handle listen socket events. Accepts a new connection request,
# allocates a WebClient to handle it, and passes the new socket
# to the WebClient
#
# @return		1
#*/
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() ?
#
#/**
# Handle socket errors.
#
# @deprecated
# @return		undef
#*/
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;
}

#/**
# Set log level. Called from WebClient when loglevel
# update is requested.
#
# @simplex
# @param $level		new log level
#
# @return		1
#*/
sub setLogLevel {
	my ($self, $level) = @_;

	$_->setLogLevel($level)
		foreach (@{$self->{_clients}});
	$self->{LogLevel} = $level;
	return 1;
}
#/**
# Set IO::Select() interval. Called when
# HTTP::Daemon::Threaded select interval is updated.
#
# @simplex
# @param $interval		new interval; fractional number of seconds
#
# @return		1
#*/
sub setListenInterval {
	$_[0]->{_sktsel}->setTimeout($_[1]);
}
#/**
# Get IO::Select() interval. Called when HTTP::Daemon::Threaded
# config info is requested.
#
# @return		current listener interval
#*/
sub getListenInterval {
	return $_[0]->{_sktsel}->getTimeout();
}

1;

