File Coverage

blib/lib/IO/Epoll.pm

Criterion	Covered	Total	%
statement	108	129	83.7
branch	25	36	69.4
condition	7	11	63.6
subroutine	23	29	79.3
pod	9	19	47.3
total	172	224	76.7

package IO::Epoll;

use 5.006;
use strict;
use warnings;
use Carp;

require Exporter;
use AutoLoader;
use POSIX ();

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use IO::Epoll ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'default' => [ qw(
	EPOLLERR
	EPOLLET
	EPOLLHUP
	EPOLLIN
	EPOLLMSG
	EPOLLOUT
	EPOLLPRI
	EPOLLRDBAND
	EPOLLRDNORM
	EPOLLWRBAND
	EPOLLWRNORM
	EPOLL_CTL_ADD
	EPOLL_CTL_DEL
	EPOLL_CTL_MOD
        epoll_create
        epoll_ctl
        epoll_wait
        epoll_pwait
) ],
                     'compat' => [ qw(
        POLLIN
        POLLOUT
        POLLERR
        POLLHUP
        POLLNVAL
        POLLPRI
        POLLRDNORM
        POLLWRNORM
        POLLRDBAND
        POLLWRBAND
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'default'} },
                   @{ $EXPORT_TAGS{'compat'}  } );

our @EXPORT = qw(
	EPOLLERR
	EPOLLET
	EPOLLHUP
	EPOLLIN
	EPOLLMSG
	EPOLLOUT
	EPOLLPRI
	EPOLLRDBAND
	EPOLLRDNORM
	EPOLLWRBAND
	EPOLLWRNORM
	EPOLL_CTL_ADD
	EPOLL_CTL_DEL
	EPOLL_CTL_MOD
        epoll_create
        epoll_ctl
        epoll_wait
        epoll_pwait
);

our $VERSION = '0.03';

sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.

    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&IO::Epoll::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if ($error) { croak $error; }
    {
	no strict 'refs';
	# Fixed between 5.005_53 and 5.005_61
#XXX	if ($] >= 5.00561) {
#XXX	    *$AUTOLOAD = sub () { $val };
#XXX	}
#XXX	else {
	    *$AUTOLOAD = sub { $val };
#XXX	}
    }
    goto &$AUTOLOAD;
}

require XSLoader;
XSLoader::load('IO::Epoll', $VERSION);

# Preloaded methods go here.

# IO::Poll Compatibility API

# [0] maps fd's to requested masks
# [1] maps fd's to returned  masks
# [2] maps fd's to handles
# [3] is the epoll fd
# [4] is the signal mask, if used. If present will use epoll_pwait() instead of epoll_wait()

sub new
{
    my $package = shift;
    my $self = bless [ {}, {}, {}, undef, undef ] => $package;

    $self->[3] = epoll_create(15);
    if ($self->[3] < 0) {
        if ($! =~ /not implemented/) {
            die "You need at least Linux 2.5.44 to use IO::Epoll";
        }
        else {
            die "epoll_create: $!\n";
        }
    }
    return $self;
}

sub mask
{
    my $self = shift;
    my $io   = shift;
    my $fd   = fileno $io;

    if (@_) {
        my $mask = shift;

        if ($mask) {
            my $combined_mask = $mask;
            my $op = &EPOLL_CTL_ADD;
            if ( exists $self->[0]{$fd} ) {
                $combined_mask |= $_ foreach values %{ $self->[0]{$fd} };
                $op = &EPOLL_CTL_MOD;
            }
            return if epoll_ctl($self->[3], $op, $fd, $combined_mask) < 0;
            $self->[0]{$fd}{$io} = $mask;
            $self->[2]{$io} = $io;
        }
        else {
            delete $self->[0]{$fd}{$io};
            delete $self->[2]{$io};

            my $op = &EPOLL_CTL_DEL;
            my $combined_mask = 0;
            if ( %{ $self->[0]{$fd} } ) {
                $combined_mask |= $_ foreach values %{ $self->[0]{$fd} };
                $op = &EPOLL_CTL_MOD;
            }
            else {
                delete $self->[1]{$fd};
                delete $self->[0]{$fd};
            }
            return if epoll_ctl($self->[3], $op, $fd, $combined_mask) < 0;
        }
    }

    return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io};
    return $self->[0]{$fd}{$io};
}

sub poll
{
    my ($self, $timeout) = @_;

    $self->[1] = {};

    # Set max events to half the number of descriptors, to a minumum of 10
    my $maxevents = int ((values %{ $self->[0] }) / 2);
    $maxevents = 10 if $maxevents < 10;

    my $msec = defined $timeout ? $timeout * 1000 : -1;

    my $ret = epoll_pwait($self->[3], $maxevents, $msec, $self->[4]);
    return -1 unless defined $ret;

    foreach my $event (@$ret) {
        $self->[1]{$event->[0]} = $event->[1];
    }
    return scalar(@$ret);
}

sub events
{
    my $self = shift;
    my $io   = shift;
    my $fd   = fileno $io;

    if ( exists $self->[1]{$fd} && exists $self->[0]{$fd}{$io} ) {
        return $self->[1]{$fd} & ($self->[0]{$fd}{$io} |
                                  &EPOLLHUP | &EPOLLERR );
    } else {
        return 0;
    }
}

sub remove
{
    my $self = shift;
    my $io   = shift;
    $self->mask($io, 0);
}

sub handles
{
    my $self = shift;
    return values %{ $self->[2] } unless @_;

    my $events = shift || 0;
    my($fd, $ev, $io, $mask);
    my @handles = ();

    while( ($fd, $ev) = each %{ $self->[1] } ) {
        while ( ($io, $mask) = each %{ $self->[0]{$fd} } ) {
            $mask |= &EPOLLHUP | &EPOLLERR;  # must allow these
            push @handles, $self->[2]{$io} if ($ev & $mask) & $events;
        }
    }
    return @handles;
}

# Close the epoll handle when object destroyed
sub DESTROY
{
    my $self = shift;

    POSIX::close($self->[3]);
}

# IO::Ppoll API extension

sub sigmask
{
    my $self = shift;

    if( my ( $newmask ) = @_ ) {
        $self->[4] = $newmask;
    }
    else {
        $self->[4] ||= POSIX::SigSet->new();
        return $self->[4];
    }
}

sub sigmask_add
{
    my $self = shift;
    my @signals = @_;

    my $sigmask = $self->sigmask;
    $sigmask->addset( $_ ) foreach @signals;
}

sub sigmask_del
{
    my $self = shift;
    my @signals = @_;

    my $sigmask = $self->sigmask;
    $sigmask->delset( $_ ) foreach @signals;
}

sub sigmask_ismember
{
    my $self = shift;
    my ( $signal ) = @_;

    return $self->sigmask->ismember( $signal );
}

# IO::Poll compatibility constants

sub POLLNVAL    () { 0            };
sub POLLIN      () { &EPOLLIN     };
sub POLLOUT     () { &EPOLLOUT    };
sub POLLERR     () { &EPOLLERR    };
sub POLLHUP     () { &EPOLLHUP    };
sub POLLPRI     () { &EPOLLPRI    };
sub POLLRDNORM  () { &EPOLLRDNORM };
sub POLLWRNORM  () { &EPOLLWRNORM };
sub POLLRDBAND  () { &EPOLLRDBAND };
sub POLLWRBAND  () { &EPOLLWRBAND };

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__