package SelectLoop;

use strict;
use vars qw($VERSION @ISA);

$VERSION = '0.20';

use FileHandle;
use Carp;

use vars qw( $Debug $Def_Timeout );
$Debug = 0;
$Def_Timeout = 0.0;
		# This means poll, do not wait; a number means wait up to
		# that many seconds; undef means wait until something opens up.

#### non-class functions (ie, things NOT callable as object->fname)

sub Debug {
 print STDERR '> ', @_ if $Debug;
}

sub _internal_handler {
  my ($type, $xyzzy) = @_;
  Debug("internal handler: type $type, @{[length($_)]} bytes of data\n");
  return (1) if ($type ne 'READ');
  ($xyzzy, $_) = ($_, '');
  (undef, $xyzzy);
}

#### class functions (ie, things callable as Object->fname or fname Object)

sub new {
  my ($class, %opt) = @_;
  Debug("creating new $class object\n");
  $opt{'do_close'} = 1			unless exists $opt{'do_close'};
  $opt{'auto_delete'} = 1		unless exists $opt{'auto_delete'};
  $opt{'handler'} = \&_internal_handler	unless exists $opt{'handler'};
  $opt{'round_robin'} = 1		unless exists $opt{'round_robin'};
  $opt{'timeout'} = $Def_Timeout	unless exists $opt{'timeout'};
  bless { 'opts'	=> {%opt},
	  'fh'		=> [],
	  'data'	=> [],
	  'handler'	=> [],
	  'args'	=> [],
	  'rmask'	=> '',
	  'last'	=> 0,
	}, $class;
}

sub DESTROY {
  my $self = shift;
  Debug("destroying object\n");
  if ($self->{'opts'}{'do_close'}) {
    my $fh;
    Debug("closing open fd's\n");
    for $fh (@{$self->{'fh'}}) {
      $fh->close if $fh;
    }
  }
}

sub timeout {
  my $self = shift;
  my $old = $self->{'opts'}{'timeout'};
  $self->{'opts'}{'timeout'} = shift if @_;
  $old;
}

# currently valid types: EOF READ DELETE
sub _invoke {
  my ($self, $i, $type) = @_;
  local ($_) = $self->{'data'}[$i];
  my @RET = &{$self->{'handler'}[$i]} ($type, @{$self->{'args'}[$i]});
  $self->{'data'}[$i] = $_;
  @RET;
}

sub delete {
  my ($self, $fd) = @_;
  my ($fn, @return);

  $fn = (ref($fd) ? $fd->fileno : $fd);
  $fd = $self->{'fh'}[$fn]
    || do { carp "can't delete fd $fn, not known!"; return undef };
  if ($self->{'opts'}{'do_close'}) {
    Debug("closing fd $fn\n");
    $fd->close;
  }

  Debug("deleting fd $fn in @{[ref($self)]}\n");

  my ($fh) = $self->{'fh'};
  if ($fn == $#$fh) {
    # (if last, pop instead of undef'ing, so we have less to search)
    my ($handler, $args, $data) = @$self{'handler', 'args', 'data'};

    @return = $self->_invoke($fn, 'DELETE') if length( $self->{'data'}[$fn] );
    @return = () if shift(@return);

    pop @$fh;    pop @$handler;    pop @$args;    pop @$data;
    while ( @$fh && ! defined $fh->[$#$fh] ) {
      pop @$fh;    pop @$handler;    pop @$args;    pop @$data;
    }

  } else {
    $self->{'fh'}[$fn] =	undef;
    $self->{'handler'}[$fn] =	undef;
    $self->{'args'}[$fn] =	undef;
    $self->{'data'}[$fn] =	undef;
  }
  vec( $self->{'rmask'}, $fn, 1 ) = 0;

  @return;
}

sub add {
  my ($self, $fd, @args) = @_;

  unless ($fd)		{ carp "no filehandle supplied";  return undef; }
  my ($fn) = $fd->fileno;
  unless (defined $fn)	{ carp "filehandle not open";  return undef; }

  Debug("adding fd $fn in @{[ref($self)]}\n");

  if ($self->{'fh'}[$fn]) {
    carp "file descriptor $fn closed unexpectedly, before or";
    $self->delete($fn);
  }

  my ($handler) = $self->{'opts'}{'handler'};
  $handler = shift(@args) if (ref($args[0]) eq 'CODE');

  $self->{'fh'}[$fn] =		$fd;
  $self->{'handler'}[$fn] =	$handler;
  $self->{'args'}[$fn] =	[@args];
  $self->{'data'}[$fn] =	'';
  vec( $self->{'rmask'}, $fn, 1 ) = 1;
}

sub _fd_indices {
  my $self = shift;

  if ($self->{'opts'}{'round_robin'}) {
    ($self->{'last'}..$#{$self->{'fh'}}, 0..($self->{'last'}-1));
    # NB: this is (0..$#{$self->{'fh'}}), "rotated" by $self->{'last'}-1.
  } else {
    (0..$#{$self->{'fh'}});
  }
}

sub do_select {
  my $self = shift;

  Debug("polling\n");
  my ($rout, $nfound);
  $nfound = select( $rout = $self->{'rmask'}, '', '',
		    $self->{'opts'}{'timeout'} );

  unless ($nfound) {
    Debug("no fd's are readable, returning empty list\n");
    return ();
  }

  my ($i, @idxs, @return);
  @idxs = $self->_fd_indices;

 ENTRY:
  for $i (@idxs) {
    if ( vec($rout, $i, 1) ) {
      Debug("fd $i is readable, invoking relevant code\n");
      $self->{'last'} = $i;
      @return = $self->_incoming($i);
      last ENTRY unless shift(@return);
      @return = ();
    }
  }
  @return;
}

sub _incoming {
  my ($self, $i) = @_;

  my ($read) = sysread ($self->{'fh'}[$i], $self->{'data'}[$i], 1024,
			length($self->{'data'}[$i]));
  if ($read) {
    $self->_invoke($i, 'READ');
  } else {
    my @eof = $self->_invoke($i, 'EOF');
    my @del = $self->delete($i);
    ($eof[0] ? @del : @eof);
  }
}

sub entries {
  my $self = shift;
  my $N = unpack("%32b*", $self->{'rmask'});
  Debug("counting, object has $N entries in it\n");
  $N;
}

1;
__END__

=head1 NAME

SelectLoop - deal with maintaining a select() loop

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 AUTHOR

Albert Dvornik, bert@mit.edu

=head1 SEE ALSO

=cut