File Coverage

lib/IOMux/Select.pm

Criterion	Covered	Total	%
statement	27	79	34.1
branch	0	34	0.0
condition	0	3	0.0
subroutine	9	17	52.9
pod	4	6	66.6
total	40	139	28.7

# Copyrights 2011-2015 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
use warnings;
use strict;

package IOMux::Select;
use vars '$VERSION';
$VERSION = '1.00';

use base 'IOMux';

use Log::Report 'iomux';

use List::Util  'min';
use POSIX       'errno_h';

$SIG{PIPE} = 'IGNORE';   # pipes are handled in select


sub init($)
{   my ($self, $args) = @_;
    $self->SUPER::init($args);
    $self->{IMS_readers} = '';
    $self->{IMS_writers} = '';
    $self->{IMS_excepts} = '';
    $self;
}

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

sub _flags2string($);
sub showFlags($;$$)
{   my $self = shift;
    return _flags2string(shift)
        if @_==1;

    my ($rdbits, $wrbits, $exbits) = @_ ? @_ : $self->selectFlags;
    my $rd = _flags2string $rdbits;
    my $wr = _flags2string $wrbits;
    my $ex = _flags2string $exbits;

    <<__SHOW;
  read: $rd
 write: $wr
except: $ex
__SHOW
}

sub _flags2string($)
{   my $bytes = shift;
    use bytes;
    my $bits  = length($bytes) * 8;
    my $out   = '';
    for my $fileno (0..$bits-1)
    {   $out .= vec($bytes, $fileno, 1)==1 ? ($fileno%10) : '-';
    }
    $out =~ s/-+$//;
    length $out ? $out : '(none)';
}

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

sub fdset($$$$$)
{   my ($self, $fileno, $state, $r, $w, $e) = @_;
    vec($self->{IMS_readers}, $fileno, 1) = $state if $r;
    vec($self->{IMS_writers}, $fileno, 1) = $state if $w;
    vec($self->{IMS_excepts}, $fileno, 1) = $state if $e;
use Carp 'cluck';
cluck 'set write bit' if $w;
    # trace "fdset(@_), now: " .$self->showFlags($self->waitFlags);
}

sub one_go($$)
{   my ($self, $wait, $heartbeat) = @_;

    trace "SELECT=\n".$self->showFlags($self->waitFlags);

    my ($rdready, $wrready, $exready)
       = @$self{ qw/IMS_readers IMS_writers IMS_excepts/ };

    my ($numready, $timeleft)
       = select $rdready, $wrready, $exready, $wait;

    trace "READY=\n".$self->showFlags($rdready, $wrready, $exready);

    if($heartbeat)
    {   # can be collected from within heartbeat
        $self->{IMS_select_flags} = [$rdready, $wrready, $exready];
        $heartbeat->($self, $numready, $timeleft)
    }

    unless(defined $numready)
    {   return if $! == EINTR || $! == EAGAIN;
        alert "leaving loop";
        return 0;
    }

    # Hopefully the regexp improves performance when many slow connections
    $self->_ready(muxReadFlagged   => $rdready) if $rdready =~ m/[^\x00]/;
    $self->_ready(muxWriteFlagged  => $wrready) if $wrready =~ m/[^\x00]/;
    $self->_ready(muxExceptFlagged => $exready) if $exready =~ m/[^\x00]/;

sleep 1;
    1;  # success
}

# It would be nice to have an algorithm which is better than O(n)
sub _ready($$)
{   my ($self, $call, $flags) = @_;
    my $handlers = $self->_handlers;
    while(my ($fileno, $conn) = each %$handlers)
    {   $conn->$call($fileno) if (vec $flags, $fileno, 1)==1;
warn "$conn $call($fileno)" if (vec $flags, $fileno, 1)==1;
    }
}


sub waitFlags()
{   my $self = shift;
    @{$self}{ qw/IMS_readers IMS_writers IMS_excepts/ };
}


sub selectFlags() { @{shift->{IMS_select_flags} || []} }

1;

__END__