package Node;

=head1 Node

This Node library supports writing single-threaded networking state-machines in Perl.  It uses the State library for implementing dynamic-class state-machines.

TODO:

* establishing TCP connections without blocking - see connect(2)

* try raw select, not IO::Select?

* what about connections that we only want to write to, not read from?

* what about UDP?

* signal handlers!

=cut

use strict;
use Carp;
use IO::Select;
use constant MAX_TIMEOUT => 10;

my $select_read = IO::Select->new;
my $select_write = IO::Select->new;

my %socket = ();

my %timeout_handler_by_time_key = ();
my %timeout_time_by_key = ();

my $running = 0;
my $from_time = 0;

=head2 set_timeout

=cut

sub set_timeout {
    my ($package, $key, $time, $handler) = @_;
    croak "cannot set a timeout in the past" if $time < $from_time;
    $timeout_handler_by_time_key{$time}{$key} = $handler;
    $timeout_time_by_key{$key} = $time;
}

=head2 cancel_timeout

=cut

sub cancel_timeout {
    my ($package, $key) = @_;
    croak "no such timeout" unless exists $timeout_time_by_key{$key};
    my $time = delete $timeout_time_by_key{$key};
    delete $timeout_handler_by_time_key{$time}{$key};
}

=head2 start

=cut

sub start {
    $running = 1;

    $from_time = time;
    for (keys %timeout_handler_by_time_key) { $from_time = $_ if $_ < $from_time }

    while ($running) {
	# the current time should not change much before the select
	my $current_time = time;
	# call handlers for any expired timeouts
	for (; $from_time <= $current_time; ++$from_time) {
	    my $timeouts = $timeout_handler_by_time_key{$from_time};
	    while (my ($key, $handler) = each %$timeouts) {
		$handler->timeout($key);
		#TODO: might need differently named timeouts per state?
	    }
	    delete $timeout_handler_by_time_key{$from_time};
	}
	
	# determine select timeout period
	my $max_timeout_time = $current_time + MAX_TIMEOUT;
	++$from_time until ($timeout_handler_by_time_key{$from_time} && %{$timeout_handler_by_time_key{$from_time}}) || $from_time == $max_timeout_time;
						      
	# select on the handles
	my ($can_read, $can_write, $has_error) = IO::Select->select($select_read, $select_write, $select_read, $from_time - $current_time);
	
	for my $handle (@$has_error) {
	    $socket{$handle}->socket_error;
	}
	
	for my $handle (@$can_write) {
	    $socket{$handle}->socket_write;
	}
	
	for my $handle (@$can_read) {
	    $socket{$handle}->socket_read;
	}
    }
}

=head2 stop

=cut

sub stop {
    $running = 0;
}

=head2 add_socket

=cut

sub add_socket {
    my ($package, $socket) = @_;
    my $handle = $socket->handle;
    $select_read->add($handle);
    $socket{$handle} = $socket;
}

=head2 remove_socket

=cut

sub remove_socket {
    my ($package, $socket) = @_;
    my $handle = $socket->handle;
    $select_read->remove($handle);
    $select_write->remove($handle);
    delete $socket{$handle};
}

=head2 start_write

=cut

sub start_write {
    my ($package, $socket) = @_;
    $select_write->add($socket->handle);
}

=head2 stop_write

=cut

sub stop_write {
    my ($package, $socket) = @_;
    $select_write->remove($socket->handle);
}

1
