File Coverage

blib/lib/POE/Wheel/ListenAccept.pm

Criterion	Covered	Total	%
statement	57	62	91.9
branch	11	24	45.8
condition	1	3	33.3
subroutine	12	14	85.7
pod	3	4	75.0
total	84	107	78.5

package POE::Wheel::ListenAccept;

use strict;

use vars qw($VERSION @ISA);
$VERSION = '1.366'; # NOTE - Should be #.### (three decimal places)

use Carp qw( croak carp );
use Symbol qw( gensym );

use POSIX qw(:fcntl_h);
use Errno qw(EWOULDBLOCK);
use POE qw( Wheel );
push @ISA, qw(POE::Wheel);

sub SELF_HANDLE       () { 0 }
sub SELF_EVENT_ACCEPT () { 1 }
sub SELF_EVENT_ERROR  () { 2 }
sub SELF_UNIQUE_ID    () { 3 }
sub SELF_STATE_ACCEPT () { 4 }

sub CRIMSON_SCOPE_HACK ($) { 0 }

#------------------------------------------------------------------------------

sub new {
  my $type = shift;
  my %params = @_;

  croak "wheels no longer require a kernel reference as their first parameter"
    if (@_ && (ref($_[0]) eq 'POE::Kernel'));

  croak "$type requires a working Kernel" unless defined $poe_kernel;

  croak "Handle required"      unless defined $params{Handle};
  croak "AcceptEvent required" unless defined $params{AcceptEvent};

  my $self = bless [ $params{Handle},                  # SELF_HANDLE
                     delete $params{AcceptEvent},      # SELF_EVENT_ACCEPT
                     delete $params{ErrorEvent},       # SELF_EVENT_ERROR
                     &POE::Wheel::allocate_wheel_id(), # SELF_UNIQUE_ID
                     undef,                            # SELF_STATE_ACCEPT
                   ], $type;
                                        # register private event handlers
  $self->_define_accept_state();
  $poe_kernel->select($self->[SELF_HANDLE], $self->[SELF_STATE_ACCEPT]);

  $self;
}

#------------------------------------------------------------------------------

sub event {
  my $self = shift;
  push(@_, undef) if (scalar(@_) & 1);

  while (@_) {
    my ($name, $event) = splice(@_, 0, 2);

    if ($name eq 'AcceptEvent') {
      if (defined $event) {
        $self->[SELF_EVENT_ACCEPT] = $event;
      }
      else {
        carp "AcceptEvent requires an event name.  ignoring undef";
      }
    }
    elsif ($name eq 'ErrorEvent') {
      $self->[SELF_EVENT_ERROR] = $event;
    }
    else {
      carp "ignoring unknown ListenAccept parameter '$name'";
    }
  }
}

#------------------------------------------------------------------------------

sub _define_accept_state {
  my $self = shift;
                                        # stupid closure trick
  my $event_accept = \$self->[SELF_EVENT_ACCEPT];
  my $event_error  = \$self->[SELF_EVENT_ERROR];
  my $handle       = $self->[SELF_HANDLE];
  my $unique_id    = $self->[SELF_UNIQUE_ID];
                                        # register the select-read handler
  $poe_kernel->state
    ( $self->[SELF_STATE_ACCEPT] =  ref($self) . "($unique_id) -> select read",
      sub {
        # prevents SEGV
        0 && CRIMSON_SCOPE_HACK('<');

        # subroutine starts here
        my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0];

        my $new_socket = gensym;
        my $peer = accept($new_socket, $handle);

        if ($peer) {
          $k->call($me, $$event_accept, $new_socket, $peer, $unique_id);
        }
        elsif ($! != EWOULDBLOCK) {
          $$event_error &&
            $k->call($me, $$event_error, 'accept', ($!+0), $!, $unique_id);
        }
      }
    );
}

#------------------------------------------------------------------------------

sub DESTROY {
  my $self = shift;
                                        # remove tentacles from our owner
  $poe_kernel->select($self->[SELF_HANDLE]);

  if ($self->[SELF_STATE_ACCEPT]) {
    $poe_kernel->state($self->[SELF_STATE_ACCEPT]);
    undef $self->[SELF_STATE_ACCEPT];
  }

  &POE::Wheel::free_wheel_id($self->[SELF_UNIQUE_ID]);
}

#------------------------------------------------------------------------------

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

1;

__END__