HTTP::Daemon::Threaded::IOSelector

package HTTP::Daemon::Threaded::IOSelector;

use IO::Select;
use Time::HiRes qw(time);

use strict;
use warnings;

our $VERSION = '0.91';

use constant HTTPD_SELECT_RD => 1;
use constant HTTPD_SELECT_WR => 2;
use constant HTTPD_SELECT_EX => 4;

sub new {
	my ($class, $interval) = @_;
#
#	create 3 selectors: read, write, and exception,
#	and accepts a static timeout to use for all
#	select() ops
#
	my $readsel = IO::Select->new();
	my $writesel = IO::Select->new();
	my $exceptsel = IO::Select->new();
	return bless [ $readsel, $writesel, $exceptsel, $interval ], $class;
}

sub addRead {
	$_[0]->[0]->add($_[1]);
	return $_[0];
}

sub addWrite {
	$_[0]->[1]->add($_[1]);
	return $_[0];
}

sub addExcept {
	$_[0]->[2]->add($_[1]);
	return $_[0];
}

sub addNoWrite {
	$_[0]->[0]->add($_[1]);
	$_[0]->[2]->add($_[1]);
	return $_[0];
}

sub addAll {
	$_[0]->[0]->add($_[1]);
	$_[0]->[1]->add($_[1]);
	$_[0]->[2]->add($_[1]);
	return $_[0];
}

sub removeRead {
	$_[0]->[0]->remove($_[1]);
	return $_[0];
}

sub removeWrite {
	$_[0]->[1]->remove($_[1]);
	return $_[0];
}

sub removeExcept {
	$_[0]->[2]->remove($_[1]);
	return $_[0];
}

sub removeNoWrite {
	$_[0]->[0]->remove($_[1]);
	$_[0]->[2]->remove($_[1]);
	return $_[0];
}

sub removeAll {

#	my @frame = caller(1);

#	print STDERR 'IOSelector removing for ',
#		join('', $frame[3], ':', $frame[2]), "\n";

	$_[0]->[0]->remove($_[1]);
	$_[0]->[1]->remove($_[1]);
	$_[0]->[2]->remove($_[1]);
	return $_[0];
}

sub getRead { return $_[0]->[0]; }

sub getWrite { return $_[0]->[1]; }

sub getExcept { return $_[0]->[2]; }

sub getAll { return ( @{$_[0]} ); }

sub setTimeout { $_[0]->[3] = $_[1]; return $_[0]; }

sub getTimeout { return $_[0]->[3] = $_[1]; }

sub select {
	my $obj = shift;

	my $start = time();
	$! = undef;
	my ($read, $write, $except) = IO::Select->select(
		$obj->[0],
		$obj->[1],
		$obj->[2],
		$obj->[3] );

	if ($! ne '') {
		print STDERR "select() failure: $!\n";
		print STDERR join("\n",
			$obj->[0]->as_string(),
			$obj->[1]->as_string(),
			$obj->[2]->as_string()), "\n";
	}
#
#	returns undef if no events
#
	return time() - $start
		unless $read;

#	print STDERR "IO::Select failed after ", time() - $start, " secs:\n",
#		join("\n", $obj->[0]->as_string(), $obj->[1]->as_string(), $obj->[2]->as_string()),
#		"\n";
#
#	consolidate selected objects, with a flag indicating which
#	events they have
#
	my %ready = ();
	my %ready_flags = ();

	$ready_flags{$_} = HTTPD_SELECT_RD,
	$ready{$_} = $_
		foreach (@$read);

	$ready_flags{$_} |= HTTPD_SELECT_WR,
	$ready{$_} = $_
		foreach (@$write);

	$ready_flags{$_} |= HTTPD_SELECT_EX,
	$ready{$_} = $_
		foreach (@$except);

	$ready{$_}->handleSocketEvent($ready_flags{$_}) foreach (keys %ready);
#
#	returns the time spent here..
#
	return time() - $start;
}