package Mud::Obj::Listener;
use strict;
use Mud::CoreTools;
use Mud::Obj;
use vars qw(@ISA);
@ISA = qw(Mud::Obj);

use POSIX qw(EWOULDBLOCK EAGAIN EINTR);

use constant LISTEN_QUEUE => 10;

=head1 Description

Mud::Obj::Listener provides listening sockets.

Listener objects are immutable and non-persistable.

=head1 Methods

=item CM new(PARAMS)

Creates a new listener object. PARAMS are passed to C<IO::Socket::INET-E<gt>new>,
except for C<Object> and C<Method> which specify the object to handle
the new connection. 

=cut

sub new {
  my ($class, %param) = @_;
  my $self = $class->SUPER::new();

  for ('Object', 'Method') { $self->{"listen_\L$_\E"} = $param{$_}; delete $param{$_}; }
  
  $param{LocalPort} ||= 5000;
  $param{Proto} ||= 'tcp';
  $param{Listen} ||= LISTEN_QUEUE;

  delete $param{Reuse} if IS_MACOS; # MacPerl seems to not like having Reuse true

  $self->{listener} = my $l = IO::Socket::INET->new(%param) or croak "Can't create listener: $!";
  fcntl($l, F_SETFL, fcntl($l, F_GETFL, 0) | O_NONBLOCK) or croak "Error setting nonblocking mode on listener: $!";
  Mud::IOManager->add($l, 'read', Mud::Obj::Event->new(target => $self->po_proxy, method => 'listen_accept'));

  mudlog "Opened listener on $param{Proto} port $param{LocalPort}";
  return $self;
}

sub DESTROY {
  if ($self->{listener}) {
    $self->{listener}->close;
    delete $self->{listener};
  }
}

sub listen_accept {
  my ($self) = @_;

  if (my $newsock = $self->{listener}->accept) {
    my $m = $self->{listen_method};
    $self->{listen_object}->$m($newsock);
  } else {
    warn $self->identity_text . " accept() failed: $!"
      unless $! == EWOULDBLOCK or $! == EAGAIN or $! == EINTR or $! == 0;
  }
}

sub storage_get_data { croak "Cannot store a ".__PACKAGE__" }

=back

=cut

1;
__END__