Группа :: Разработка/Perl
Пакет: perl-IO-Epoll
навигация по пакетам
Главная Изменения Спек Патчи Исходники Загрузить Gear Bugs and FR Repocop
IO-Epoll-0.02/ 0000755 0000000 0000000 00000000000 11150026374 0013010 5 ustar 00root root 0000000 0000000 IO-Epoll-0.02/Changes 0000644 0000000 0000000 00000000636 11150026374 0014310 0 ustar 00root root 0000000 0000000 Revision history for Perl extension IO::Epoll.
0.01 Sat Feb 28 15:32:58 2004
- original version; created by h2xs 1.23 with options
-b 5.6.0 -n IO::Epoll sys/epoll.h
0.02 Sat Jan 24 14:19:22 PST 2009
- Applied patches from Paul LeoNerd Evans:
* Ensure ->poll returns correct value on error;
* Ensure that ->poll interprets timeout correctly
* Add support for epoll_pwait, and IO::Ppoll compatibility
IO-Epoll-0.02/Epoll.xs 0000644 0000000 0000000 00000004236 11150026374 0014444 0 ustar 00root root 0000000 0000000 #include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include <sys/epoll.h>
#include "const-c.inc"
MODULE = IO::Epoll PACKAGE = IO::Epoll
INCLUDE: const-xs.inc
int
epoll_create(size)
int size
int
epoll_ctl(epfd,op,fd,events)
int epfd
int op
int fd
unsigned long events
CODE:
struct epoll_event event;
int ret;
event.events = events;
event.data.fd = fd;
RETVAL = epoll_ctl(epfd, op, fd, &event);
OUTPUT:
RETVAL
SV *
epoll_wait(epfd,maxevents,timeout)
int epfd
int maxevents
int timeout
CODE:
struct epoll_event *events;
int ret, i;
events = (struct epoll_event *)malloc(maxevents * sizeof(struct epoll_event));
if (!events) {
errno = ENOMEM;
XSRETURN_UNDEF;
}
ret = epoll_wait(epfd, events, maxevents, timeout);
if (ret < 0) {
free(events);
XSRETURN_UNDEF;
} else {
AV *results = (AV*)sv_2mortal((SV*)newAV());
for (i = 0; i < ret; i++) {
AV *ev = (AV*)sv_2mortal((SV*)newAV());
av_push(ev, newSVnv(events[i].data.fd));
av_push(ev, newSVnv(events[i].events));
av_push(results, newRV((SV*) ev));
}
RETVAL = newRV((SV *)results);
free(events);
}
OUTPUT:
RETVAL
SV *
epoll_pwait(epfd,maxevents,timeout,sigmask)
int epfd
int maxevents
int timeout
SV *sigmask
CODE:
struct epoll_event *events;
sigset_t *sigmask_real;
int ret, i;
if(SvOK(sigmask)) {
if(!sv_derived_from(sigmask, "POSIX::SigSet"))
Perl_croak(aTHX_ "epoll_pwait: sigmask is not of type POSIX::SigSet");
/* This code borrowed from POSIX.xs */
IV tmp = SvIV((SV*)SvRV(sigmask));
sigmask_real = INT2PTR(sigset_t*, tmp);
}
else {
sigmask_real = NULL;
}
events = (struct epoll_event *)malloc(maxevents * sizeof(struct epoll_event));
if (!events) {
errno = ENOMEM;
XSRETURN_UNDEF;
}
ret = epoll_pwait(epfd, events, maxevents, timeout, sigmask_real);
if (ret < 0) {
free(events);
XSRETURN_UNDEF;
} else {
AV *results = (AV*)sv_2mortal((SV*)newAV());
for (i = 0; i < ret; i++) {
AV *ev = (AV*)sv_2mortal((SV*)newAV());
av_push(ev, newSVnv(events[i].data.fd));
av_push(ev, newSVnv(events[i].events));
av_push(results, newRV((SV*) ev));
}
RETVAL = newRV((SV *)results);
free(events);
}
OUTPUT:
RETVAL
IO-Epoll-0.02/MANIFEST 0000644 0000000 0000000 00000000364 11150026374 0014144 0 ustar 00root root 0000000 0000000 Changes
Epoll.xs
Makefile.PL
MANIFEST
ppport.h
README
t/IO-Epoll.t
t/IO-Poll-compat.t
t/IO-Ppoll-compat.t
fallback/const-c.inc
fallback/const-xs.inc
lib/IO/Epoll.pm
META.yml Module meta-data (added by MakeMaker)
IO-Epoll-0.02/META.yml 0000644 0000000 0000000 00000001000 11150026374 0014250 0 ustar 00root root 0000000 0000000 --- #YAML:1.0
name: IO-Epoll
version: 0.02
abstract: Scalable IO Multiplexing for Linux 2.5.44 and higher
author:
- Bruce J Keeler <bruce@gridpoint.com>
license: unknown
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
requires: {}
no_index:
directory:
- t
- inc
generated_by: ExtUtils::MakeMaker version 6.48
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
IO-Epoll-0.02/Makefile.PL 0000644 0000000 0000000 00000003611 11150026374 0014763 0 ustar 00root root 0000000 0000000 use 5.006;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'IO::Epoll',
VERSION_FROM => 'lib/IO/Epoll.pm', # finds $VERSION
PREREQ_PM => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/IO/Epoll.pm', # retrieve abstract from module
AUTHOR => 'Bruce J Keeler <bruce@gridpoint.com>') : ()),
LIBS => [''], # e.g., '-lm'
DEFINE => '', # e.g., '-DHAVE_SOMETHING'
INC => '-I.', # e.g., '-I. -I/usr/include/other'
# Un-comment this if you add C files to link with later:
# OBJECT => '$(O_FILES)', # link all the C files too
);
if (eval {require ExtUtils::Constant; 1}) {
# If you edit these definitions to change the constants used by this module,
# you will need to use the generated const-c.inc and const-xs.inc
# files to replace their "fallback" counterparts before distributing your
# changes.
my @names = (qw(EPOLLERR EPOLLET EPOLLHUP EPOLLIN EPOLLMSG EPOLLOUT EPOLLPRI
EPOLLRDBAND EPOLLRDNORM EPOLLWRBAND EPOLLWRNORM EPOLL_CTL_ADD
EPOLL_CTL_DEL EPOLL_CTL_MOD));
ExtUtils::Constant::WriteConstants(
NAME => 'IO::Epoll',
NAMES => \@names,
DEFAULT_TYPE => 'IV',
C_FILE => 'const-c.inc',
XS_FILE => 'const-xs.inc',
);
}
else {
use File::Copy;
use File::Spec;
foreach my $file ('const-c.inc', 'const-xs.inc') {
my $fallback = File::Spec->catfile('fallback', $file);
copy ($fallback, $file) or die "Can't copy $fallback to $file: $!";
}
}
IO-Epoll-0.02/README 0000644 0000000 0000000 00000001674 11150026374 0013700 0 ustar 00root root 0000000 0000000 IO-Epoll version 0.01
=====================
The epoll(4) subsystem is a new, (currently) Linux-specific variant of
poll(2). It is designed to offer O(1) scalability over large numbers of
watched file descriptors. You will need at least version 2.5.44 of Linux
to use this module, and you might need to upgrade your C library.
The epoll(2) API comprises three system calls: epoll_create(2),
epoll_ctl(2) and epoll_wait(2). IO::Epoll provides a low-level
API which closely matches the underlying system calls. It also provides
a higher-level layer designed to emulate the behavior of IO::Poll>.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
COPYRIGHT AND LICENCE
Copyright (C) 2004 by Bruce J. Keeler
Portions derived from IO::Poll, Copyright (c) 1997-8 Graham Barr
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
IO-Epoll-0.02/fallback/ 0000755 0000000 0000000 00000000000 11150026374 0014547 5 ustar 00root root 0000000 0000000 IO-Epoll-0.02/fallback/const-c.inc 0000644 0000000 0000000 00000015125 11150026374 0016614 0 ustar 00root root 0000000 0000000 #define PERL_constant_NOTFOUND 1
#define PERL_constant_NOTDEF 2
#define PERL_constant_ISIV 3
#define PERL_constant_ISNO 4
#define PERL_constant_ISNV 5
#define PERL_constant_ISPV 6
#define PERL_constant_ISPVN 7
#define PERL_constant_ISSV 8
#define PERL_constant_ISUNDEF 9
#define PERL_constant_ISUV 10
#define PERL_constant_ISYES 11
#ifndef NVTYPE
typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */
#endif
#ifndef aTHX_
#define aTHX_ /* 5.6 or later define this for threading support. */
#endif
#ifndef pTHX_
#define pTHX_ /* 5.6 or later define this for threading support. */
#endif
static int
constant_8 (pTHX_ const char *name, IV *iv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
EPOLLERR EPOLLHUP EPOLLMSG EPOLLOUT EPOLLPRI */
/* Offset 5 gives the best switch position. */
switch (name[5]) {
case 'E':
if (memEQ(name, "EPOLLERR", 8)) {
/* ^ */
#ifdef EPOLLERR
*iv_return = EPOLLERR;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'H':
if (memEQ(name, "EPOLLHUP", 8)) {
/* ^ */
#ifdef EPOLLHUP
*iv_return = EPOLLHUP;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'M':
if (memEQ(name, "EPOLLMSG", 8)) {
/* ^ */
#ifdef EPOLLMSG
*iv_return = EPOLLMSG;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'O':
if (memEQ(name, "EPOLLOUT", 8)) {
/* ^ */
#ifdef EPOLLOUT
*iv_return = EPOLLOUT;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'P':
if (memEQ(name, "EPOLLPRI", 8)) {
/* ^ */
#ifdef EPOLLPRI
*iv_return = EPOLLPRI;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
}
return PERL_constant_NOTFOUND;
}
static int
constant_11 (pTHX_ const char *name, IV *iv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
EPOLLRDBAND EPOLLRDNORM EPOLLWRBAND EPOLLWRNORM */
/* Offset 9 gives the best switch position. */
switch (name[9]) {
case 'N':
if (memEQ(name, "EPOLLRDBAND", 11)) {
/* ^ */
#ifdef EPOLLRDBAND
*iv_return = EPOLLRDBAND;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
if (memEQ(name, "EPOLLWRBAND", 11)) {
/* ^ */
#ifdef EPOLLWRBAND
*iv_return = EPOLLWRBAND;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'R':
if (memEQ(name, "EPOLLRDNORM", 11)) {
/* ^ */
#ifdef EPOLLRDNORM
*iv_return = EPOLLRDNORM;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
if (memEQ(name, "EPOLLWRNORM", 11)) {
/* ^ */
#ifdef EPOLLWRNORM
*iv_return = EPOLLWRNORM;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
}
return PERL_constant_NOTFOUND;
}
static int
constant_13 (pTHX_ const char *name, IV *iv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
EPOLL_CTL_ADD EPOLL_CTL_DEL EPOLL_CTL_MOD */
/* Offset 11 gives the best switch position. */
switch (name[11]) {
case 'D':
if (memEQ(name, "EPOLL_CTL_ADD", 13)) {
/* ^ */
#ifdef EPOLL_CTL_ADD
*iv_return = EPOLL_CTL_ADD;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'E':
if (memEQ(name, "EPOLL_CTL_DEL", 13)) {
/* ^ */
#ifdef EPOLL_CTL_DEL
*iv_return = EPOLL_CTL_DEL;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'O':
if (memEQ(name, "EPOLL_CTL_MOD", 13)) {
/* ^ */
#ifdef EPOLL_CTL_MOD
*iv_return = EPOLL_CTL_MOD;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
}
return PERL_constant_NOTFOUND;
}
static int
constant (pTHX_ const char *name, STRLEN len, IV *iv_return) {
/* Initially switch on the length of the name. */
/* When generated this function returned values for the list of names given
in this section of perl code. Rather than manually editing these functions
to add or remove constants, which would result in this comment and section
of code becoming inaccurate, we recommend that you edit this section of
code, and use it to regenerate a new set of constant functions which you
then use to replace the originals.
Regenerate these constant functions by feeding this entire source file to
perl -x
#!/usr/bin/perl -w
use ExtUtils::Constant qw (constant_types C_constant XS_constant);
my $types = {map {($_, 1)} qw(IV)};
my @names = (qw(EPOLLERR EPOLLET EPOLLHUP EPOLLIN EPOLLMSG EPOLLOUT EPOLLPRI
EPOLLRDBAND EPOLLRDNORM EPOLLWRBAND EPOLLWRNORM EPOLL_CTL_ADD
EPOLL_CTL_DEL EPOLL_CTL_MOD));
print constant_types(); # macro defs
foreach (C_constant ("IO::Epoll", 'constant', 'IV', $types, undef, 3, @names) ) {
print $_, "\n"; # C constant subs
}
print "#### XS Section:\n";
print XS_constant ("IO::Epoll", $types);
__END__
*/
switch (len) {
case 7:
/* Names all of length 7. */
/* EPOLLET EPOLLIN */
/* Offset 5 gives the best switch position. */
switch (name[5]) {
case 'E':
if (memEQ(name, "EPOLLET", 7)) {
/* ^ */
#ifdef EPOLLET
*iv_return = EPOLLET;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'I':
if (memEQ(name, "EPOLLIN", 7)) {
/* ^ */
#ifdef EPOLLIN
*iv_return = EPOLLIN;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
}
break;
case 8:
return constant_8 (aTHX_ name, iv_return);
break;
case 11:
return constant_11 (aTHX_ name, iv_return);
break;
case 13:
return constant_13 (aTHX_ name, iv_return);
break;
}
return PERL_constant_NOTFOUND;
}
IO-Epoll-0.02/fallback/const-xs.inc 0000644 0000000 0000000 00000005133 11150026374 0017022 0 ustar 00root root 0000000 0000000 void
constant(sv)
PREINIT:
#ifdef dXSTARG
dXSTARG; /* Faster if we have it. */
#else
dTARGET;
#endif
STRLEN len;
int type;
IV iv;
/* NV nv; Uncomment this if you need to return NVs */
/* const char *pv; Uncomment this if you need to return PVs */
INPUT:
SV * sv;
const char * s = SvPV(sv, len);
PPCODE:
/* Change this to constant(aTHX_ s, len, &iv, &nv);
if you need to return both NVs and IVs */
type = constant(aTHX_ s, len, &iv);
/* Return 1 or 2 items. First is error message, or undef if no error.
Second, if present, is found value */
switch (type) {
case PERL_constant_NOTFOUND:
sv = sv_2mortal(newSVpvf("%s is not a valid IO::Epoll macro", s));
PUSHs(sv);
break;
case PERL_constant_NOTDEF:
sv = sv_2mortal(newSVpvf(
"Your vendor has not defined IO::Epoll macro %s, used", s));
PUSHs(sv);
break;
case PERL_constant_ISIV:
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
PUSHi(iv);
break;
/* Uncomment this if you need to return NOs
case PERL_constant_ISNO:
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
PUSHs(&PL_sv_no);
break; */
/* Uncomment this if you need to return NVs
case PERL_constant_ISNV:
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
PUSHn(nv);
break; */
/* Uncomment this if you need to return PVs
case PERL_constant_ISPV:
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
PUSHp(pv, strlen(pv));
break; */
/* Uncomment this if you need to return PVNs
case PERL_constant_ISPVN:
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
PUSHp(pv, iv);
break; */
/* Uncomment this if you need to return SVs
case PERL_constant_ISSV:
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
PUSHs(sv);
break; */
/* Uncomment this if you need to return UNDEFs
case PERL_constant_ISUNDEF:
break; */
/* Uncomment this if you need to return UVs
case PERL_constant_ISUV:
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
PUSHu((UV)iv);
break; */
/* Uncomment this if you need to return YESs
case PERL_constant_ISYES:
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
PUSHs(&PL_sv_yes);
break; */
default:
sv = sv_2mortal(newSVpvf(
"Unexpected return type %d while processing IO::Epoll macro %s, used",
type, s));
PUSHs(sv);
}
IO-Epoll-0.02/lib/ 0000755 0000000 0000000 00000000000 11150026374 0013556 5 ustar 00root root 0000000 0000000 IO-Epoll-0.02/lib/IO/ 0000755 0000000 0000000 00000000000 11150026374 0014065 5 ustar 00root root 0000000 0000000 IO-Epoll-0.02/lib/IO/Epoll.pm 0000644 0000000 0000000 00000032423 11150026374 0015502 0 ustar 00root root 0000000 0000000 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.02';
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__
=head1 NAME
IO::Epoll - Scalable IO Multiplexing for Linux 2.5.44 and higher
=head1 SYNOPSIS
# Low level interface
use IO::Epoll;
$epfd = epoll_create(10);
epoll_ctl($epfd, EPOLL_CTL_ADD, fileno STDIN, EPOLLIN) >= 0
|| die "epoll_ctl: $!\n";
epoll_ctl($epfd, ...);
$events = epoll_wait($epfd, 10, 1000); # Max 10 events returned, 1s timeout
# High level IO::Poll emulation layer
use IO::EPoll qw(:compat);
$poll = new IO::Epoll;
$poll->mask($input_handle => POLLIN);
$poll->mask($output_handle => POLLOUT);
$poll->poll($timeout);
$ev = $poll->events($input);
=head1 DESCRIPTION
The C<epoll(4)> subsystem is a new, (currently) Linux-specific variant of
C<poll(2)>. It is designed to offer O(1) scalability over large numbers of
watched file descriptors. You will need at least version 2.5.44 of Linux
to use this module, and you might need to upgrade your C library.
The C<epoll(2)> API comprises four system calls: C<epoll_create(2)>,
C<epoll_ctl(2)>, C<epoll_wait(2)> and C<epoll_pwait(2)>. C<IO::Epoll>
provides a low-level API which closely matches the underlying system calls.
It also provides a higher-level layer designed to emulate the behavior of
C<IO::Poll> and C<IO::Ppoll>.
=head1 LOW-LEVEL API
=over 4
=head2 epoll_create
Create a new C<epoll> file descriptor by requesting the kernel
allocate an event backing store dimensioned for C<size> descriptors.
The size is not the maximum size of the backing store but just a hint
to the kernel about how to dimension internal structures. The
returned file descriptor will be used for all the subsequent calls
to the C<epoll> interface. The file descriptor returned by
C<epoll_create> must be closed by using C<POSIX::close>.
$epfd = epoll_create(15);
...
POSIX::close($epfd);
When successful, C<epoll_create> returns a positive integer
identifying the descriptor. When an error occurs, C<epoll_create>
returns -1 and errno is set appropriately.
=head2 epoll_ctl
Control an C<epoll> descriptor, $epfd, by requesting the operation op be
performed on the target file descriptor, fd.
$ret = epoll_ctl($epfd, $op, $fd, $eventmask)
C<$epfd> is an C<epoll> descriptor returned from C<epoll_create>.
C<$op> is one of C<EPOLL_CTL_ADD>, C<EPOLL_CTL_MOD> or C<EPOLL_CTL_DEL>.
C<$fd> is the file desciptor to be watched.
C<$eventmask> is a bitmask of events defined by C<EPOLLIN>, C<EPOLLOUT>, etc.
When successful, C<epoll_ctl> returns 0. When an error occurs,
C<epoll_ctl> returns -1 and errno is set appropriately.
=head2 epoll_wait
Wait for events on the C<epoll> file descriptor C<$epfd>.
$ret = epoll_wait($epfd, $maxevents, $timeout)
C<$epfd> is an C<epoll> descriptor returned from C<epoll_create>.
C<$maxevents> is an integer specifying the maximum number of events to
be returned.
C<$timeout> is a timeout, in milliseconds
When successful, C<epoll_wait> returns a reference to an array of
events. Each event is a two element array, the first element being
the file descriptor which triggered the event, and the second is the
mask of event types triggered. For example, if C<epoll_wait> returned the
following data structure:
[
[ 0, EPOLLIN ],
[ 6, EPOLLOUT | EPOLLIN ]
]
then file descriptor 0 would be ready for reading, and fd 4 would be
ready for both reading and writing.
On error, C<epoll_wait> returns undef and sets C<errno> appropriately.
=head2 epoll_pwait
Wait for events on the C<epoll> file descriptor C<$epfd>.
$ret = epoll_pwait($epfd, $maxevents, $timeout, $sigmask)
Identical to C<epoll_wait>, except that the kernel will atomically swap the
current signal mask for the process to that supplied in C<$sigmask>, wait for
events, then restore it to what it was originally. The C<$sigmask> parameter
should be undef, or an instance of C<POSIX::SigSet>.
=back
=head1 HIGH LEVEL API
IO::Epoll provides an object oriented API designed to be a drop-in
replacement for IO::Poll. See the documentation for that module for
more information.
=head1 METHODS
=over 4
=item mask ( IO [, EVENT_MASK ] )
If EVENT_MASK is given, then, if EVENT_MASK is non-zero, IO is added to the
list of file descriptors and the next call to poll will check for
any event specified in EVENT_MASK. If EVENT_MASK is zero then IO will be
removed from the list of file descriptors.
If EVENT_MASK is not given then the return value will be the current
event mask value for IO.
=item poll ( [ TIMEOUT ] )
Call the system level poll routine. If TIMEOUT is not specified then the
call will block. Returns the number of handles which had events
happen, or -1 on error. TIMEOUT is in seconds and may be fractional.
=item events ( IO )
Returns the event mask which represents the events that happend on IO
during the last call to C<poll>.
=item remove ( IO )
Remove IO from the list of file descriptors for the next poll.
=item handles( [ EVENT_MASK ] )
Returns a list of handles. If EVENT_MASK is not given then a list of all
handles known will be returned. If EVENT_MASK is given then a list
of handles will be returned which had one of the events specified by
EVENT_MASK happen during the last call ti C<poll>
=back
=head1 IO::Ppoll METHODS
IO::Epoll also provides methods compatible with IO::Ppoll. When any of these
methods are called, the IO::Epoll object switches up to IO::Ppoll-compatible
mode, and will use the C<epoll_pwait(2)> system call when the C<poll> method
is invoked.
=over 4
=item sigmask
Returns the C<POSIX::SigSet> object in which the signal mask is stored. Since
this is a reference to the object used in the call to C<epoll_pwait(2)>, any
modifications made to it will be reflected in the signal mask given to the
system call.
=item sigmask_add ( SIGNALS )
Adds the given signals to the signal mask. These signals will be blocked
during the C<poll> call.
=item sigmask_del ( SIGNALS )
Removes the given signals from the signal mask. These signals will not be
blocked during the C<poll> call, and may be delivered while C<poll> is
waiting.
=item sigmask_ismember ( SIGNAL )
Tests if the given signal is present in the signal mask.
=back
=head1 Exportable constants
Exported by default:
EPOLLERR
EPOLLET
EPOLLHUP
EPOLLIN
EPOLLMSG
EPOLLOUT
EPOLLPRI
EPOLLRDBAND
EPOLLRDNORM
EPOLLWRBAND
EPOLLWRNORM
EPOLL_CTL_ADD
EPOLL_CTL_DEL
EPOLL_CTL_MOD
Exported by the :compat tag:
POLLNVAL
POLLIN
POLLOUT
POLLERR
POLLHUP
POLLPRI
POLLRDNORM
POLLWRNORM
POLLRDBAND
POLLWRBAND
=head1 SEE ALSO
C<IO::Poll> C<IO::Select> C<IO::Ppoll> C<epoll(4)> C<epoll_create(2)>
C<epoll_ctl(2)> C<epoll_wait(2)> C<epoll_pwait(2)>
=head1 AUTHOR
Bruce J Keeler, E<lt>bruce@gridpoint.comE<gt>
=head1 CREDITS
The C<IO::Poll> compatibility code borrows heavily from the C<IO::Poll>
code itself, which was written by Graham Barr.
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2004 by Bruce J. Keeler
Portions Copyright (C) 1997-8 Graham Barr <gbarr@pobox.com>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
IO-Epoll-0.02/ppport.h 0000644 0000000 0000000 00000072141 11150026374 0014512 0 ustar 00root root 0000000 0000000
/* ppport.h -- Perl/Pollution/Portability Version 2.011
*
* Automatically Created by Devel::PPPort on Sat Feb 28 15:32:58 2004
*
* Do NOT edit this file directly! -- Edit PPPort.pm instead.
*
* Version 2.x, Copyright (C) 2001, Paul Marquess.
* Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
* This code may be used and distributed under the same license as any
* version of Perl.
*
* This version of ppport.h is designed to support operation with Perl
* installations back to 5.004, and has been tested up to 5.8.1.
*
* If this version of ppport.h is failing during the compilation of this
* module, please check if a newer version of Devel::PPPort is available
* on CPAN before sending a bug report.
*
* If you are using the latest version of Devel::PPPort and it is failing
* during compilation of this module, please send a report to perlbug@perl.com
*
* Include all following information:
*
* 1. The complete output from running "perl -V"
*
* 2. This file.
*
* 3. The name & version of the module you were trying to build.
*
* 4. A full log of the build that failed.
*
* 5. Any other information that you think could be relevant.
*
*
* For the latest version of this code, please retreive the Devel::PPPort
* module from CPAN.
*
*/
/*
* In order for a Perl extension module to be as portable as possible
* across differing versions of Perl itself, certain steps need to be taken.
* Including this header is the first major one, then using dTHR is all the
* appropriate places and using a PL_ prefix to refer to global Perl
* variables is the second.
*
*/
/* If you use one of a few functions that were not present in earlier
* versions of Perl, please add a define before the inclusion of ppport.h
* for a static include, or use the GLOBAL request in a single module to
* produce a global definition that can be referenced from the other
* modules.
*
* Function: Static define: Extern define:
* newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
*
*/
/* To verify whether ppport.h is needed for your module, and whether any
* special defines should be used, ppport.h can be run through Perl to check
* your source code. Simply say:
*
* perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
*
* The result will be a list of patches suggesting changes that should at
* least be acceptable, if not necessarily the most efficient solution, or a
* fix for all possible problems. It won't catch where dTHR is needed, and
* doesn't attempt to account for global macro or function definitions,
* nested includes, typemaps, etc.
*
* In order to test for the need of dTHR, please try your module under a
* recent version of Perl that has threading compiled-in.
*
*/
/*
#!/usr/bin/perl
@ARGV = ("*.xs") if !@ARGV;
%badmacros = %funcs = %macros = (); $replace = 0;
foreach (<DATA>) {
$funcs{$1} = 1 if /Provide:\s+(\S+)/;
$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
$replace = $1 if /Replace:\s+(\d+)/;
$badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
}
foreach $filename (map(glob($_),@ARGV)) {
unless (open(IN, "<$filename")) {
warn "Unable to read from $file: $!\n";
next;
}
print "Scanning $filename...\n";
$c = ""; while (<IN>) { $c .= $_; } close(IN);
$need_include = 0; %add_func = (); $changes = 0;
$has_include = ($c =~ /#.*include.*ppport/m);
foreach $func (keys %funcs) {
if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
if ($c !~ /\b$func\b/m) {
print "If $func isn't needed, you don't need to request it.\n" if
$changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
} else {
print "Uses $func\n";
$need_include = 1;
}
} else {
if ($c =~ /\b$func\b/m) {
$add_func{$func} =1 ;
print "Uses $func\n";
$need_include = 1;
}
}
}
if (not $need_include) {
foreach $macro (keys %macros) {
if ($c =~ /\b$macro\b/m) {
print "Uses $macro\n";
$need_include = 1;
}
}
}
foreach $badmacro (keys %badmacros) {
if ($c =~ /\b$badmacro\b/m) {
$changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
$need_include = 1;
}
}
if (scalar(keys %add_func) or $need_include != $has_include) {
if (!$has_include) {
$inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
"#include \"ppport.h\"\n";
$c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
} elsif (keys %add_func) {
$inc = join('',map("#define NEED_$_\n", sort keys %add_func));
$c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
}
if (!$need_include) {
print "Doesn't seem to need ppport.h.\n";
$c =~ s/^.*#.*include.*ppport.*\n//m;
}
$changes++;
}
if ($changes) {
open(OUT,">/tmp/ppport.h.$$");
print OUT $c;
close(OUT);
open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
close(DIFF);
unlink("/tmp/ppport.h.$$");
} else {
print "Looks OK\n";
}
}
__DATA__
*/
#ifndef _P_P_PORTABILITY_H_
#define _P_P_PORTABILITY_H_
#ifndef PERL_REVISION
# ifndef __PATCHLEVEL_H_INCLUDED__
# define PERL_PATCHLEVEL_H_IMPLICIT
# include <patchlevel.h>
# endif
# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
# include <could_not_find_Perl_patchlevel.h>
# endif
# ifndef PERL_REVISION
# define PERL_REVISION (5)
/* Replace: 1 */
# define PERL_VERSION PATCHLEVEL
# define PERL_SUBVERSION SUBVERSION
/* Replace PERL_PATCHLEVEL with PERL_VERSION */
/* Replace: 0 */
# endif
#endif
#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
/* It is very unlikely that anyone will try to use this with Perl 6
(or greater), but who knows.
*/
#if PERL_REVISION != 5
# error ppport.h only works with Perl version 5
#endif /* PERL_REVISION != 5 */
#ifndef ERRSV
# define ERRSV perl_get_sv("@",FALSE)
#endif
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
/* Replace: 1 */
# define PL_Sv Sv
# define PL_compiling compiling
# define PL_copline copline
# define PL_curcop curcop
# define PL_curstash curstash
# define PL_defgv defgv
# define PL_dirty dirty
# define PL_dowarn dowarn
# define PL_hints hints
# define PL_na na
# define PL_perldb perldb
# define PL_rsfp_filters rsfp_filters
# define PL_rsfpv rsfp
# define PL_stdingv stdingv
# define PL_sv_no sv_no
# define PL_sv_undef sv_undef
# define PL_sv_yes sv_yes
/* Replace: 0 */
#endif
#ifdef HASATTRIBUTE
# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
# define PERL_UNUSED_DECL
# else
# define PERL_UNUSED_DECL __attribute__((unused))
# endif
#else
# define PERL_UNUSED_DECL
#endif
#ifndef dNOOP
# define NOOP (void)0
# define dNOOP extern int Perl___notused PERL_UNUSED_DECL
#endif
#ifndef dTHR
# define dTHR dNOOP
#endif
#ifndef dTHX
# define dTHX dNOOP
# define dTHXa(x) dNOOP
# define dTHXoa(x) dNOOP
#endif
#ifndef pTHX
# define pTHX void
# define pTHX_
# define aTHX
# define aTHX_
#endif
#ifndef dAX
# define dAX I32 ax = MARK - PL_stack_base + 1
#endif
#ifndef dITEMS
# define dITEMS I32 items = SP - MARK
#endif
/* IV could also be a quad (say, a long long), but Perls
* capable of those should have IVSIZE already. */
#if !defined(IVSIZE) && defined(LONGSIZE)
# define IVSIZE LONGSIZE
#endif
#ifndef IVSIZE
# define IVSIZE 4 /* A bold guess, but the best we can make. */
#endif
#ifndef UVSIZE
# define UVSIZE IVSIZE
#endif
#ifndef NVTYPE
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
# define NVTYPE long double
# else
# define NVTYPE double
# endif
typedef NVTYPE NV;
#endif
#ifndef INT2PTR
#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
# define PTRV UV
# define INT2PTR(any,d) (any)(d)
#else
# if PTRSIZE == LONGSIZE
# define PTRV unsigned long
# else
# define PTRV unsigned
# endif
# define INT2PTR(any,d) (any)(PTRV)(d)
#endif
#define NUM2PTR(any,d) (any)(PTRV)(d)
#define PTR2IV(p) INT2PTR(IV,p)
#define PTR2UV(p) INT2PTR(UV,p)
#define PTR2NV(p) NUM2PTR(NV,p)
#if PTRSIZE == LONGSIZE
# define PTR2ul(p) (unsigned long)(p)
#else
# define PTR2ul(p) INT2PTR(unsigned long,p)
#endif
#endif /* !INT2PTR */
#ifndef boolSV
# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#endif
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
#endif
#ifndef newSVpvn
# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
#endif
#ifndef newRV_inc
/* Replace: 1 */
# define newRV_inc(sv) newRV(sv)
/* Replace: 0 */
#endif
/* DEFSV appears first in 5.004_56 */
#ifndef DEFSV
# define DEFSV GvSV(PL_defgv)
#endif
#ifndef SAVE_DEFSV
# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif
#ifndef newRV_noinc
# ifdef __GNUC__
# define newRV_noinc(sv) \
({ \
SV *nsv = (SV*)newRV(sv); \
SvREFCNT_dec(sv); \
nsv; \
})
# else
# if defined(USE_THREADS)
static SV * newRV_noinc (SV * sv)
{
SV *nsv = (SV*)newRV(sv);
SvREFCNT_dec(sv);
return nsv;
}
# else
# define newRV_noinc(sv) \
(PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
# endif
# endif
#endif
/* Provide: newCONSTSUB */
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
#if defined(NEED_newCONSTSUB)
static
#else
extern void newCONSTSUB(HV * stash, char * name, SV *sv);
#endif
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
void
newCONSTSUB(stash,name,sv)
HV *stash;
char *name;
SV *sv;
{
U32 oldhints = PL_hints;
HV *old_cop_stash = PL_curcop->cop_stash;
HV *old_curstash = PL_curstash;
line_t oldline = PL_curcop->cop_line;
PL_curcop->cop_line = PL_copline;
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash)
PL_curstash = PL_curcop->cop_stash = stash;
newSUB(
#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
/* before 5.003_22 */
start_subparse(),
#else
# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
/* 5.003_22 */
start_subparse(0),
# else
/* 5.003_23 onwards */
start_subparse(FALSE, 0),
# endif
#endif
newSVOP(OP_CONST, 0, newSVpv(name,0)),
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
PL_hints = oldhints;
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
PL_curcop->cop_line = oldline;
}
#endif
#endif /* newCONSTSUB */
#ifndef START_MY_CXT
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
* this, if you want to make the extension thread-safe. See ext/re/re.xs
* for an example of the use of these macros.
*
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
* 4. Use the MY_CXT_INIT macro such that it is called exactly once
* (typically put in the BOOT: section).
* 5. Use the members of the my_cxt_t structure everywhere as
* MY_CXT.member.
* 6. Use the dMY_CXT macro (a declaration) in all the functions that
* access MY_CXT.
*/
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
/* This must appear in all extensions that define a my_cxt_t structure,
* right after the definition (i.e. at file scope). The non-threads
* case below uses it to declare the data as static. */
#define START_MY_CXT
#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
/* Fetches the SV that keeps the per-interpreter data. */
#define dMY_CXT_SV \
SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
#else /* >= perl5.004_68 */
#define dMY_CXT_SV \
SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
sizeof(MY_CXT_KEY)-1, TRUE)
#endif /* < perl5.004_68 */
/* This declaration should be used within all functions that use the
* interpreter-local data. */
#define dMY_CXT \
dMY_CXT_SV; \
my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
/* Creates and zeroes the per-interpreter data.
* (We allocate my_cxtp in a Perl SV so that it will be released when
* the interpreter goes away.) */
#define MY_CXT_INIT \
dMY_CXT_SV; \
/* newSV() allocates one more than needed */ \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
Zero(my_cxtp, 1, my_cxt_t); \
sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
/* This macro must be used to access members of the my_cxt_t structure.
* e.g. MYCXT.some_data */
#define MY_CXT (*my_cxtp)
/* Judicious use of these macros can reduce the number of times dMY_CXT
* is used. Use is similar to pTHX, aTHX etc. */
#define pMY_CXT my_cxt_t *my_cxtp
#define pMY_CXT_ pMY_CXT,
#define _pMY_CXT ,pMY_CXT
#define aMY_CXT my_cxtp
#define aMY_CXT_ aMY_CXT,
#define _aMY_CXT ,aMY_CXT
#else /* single interpreter */
#define START_MY_CXT static my_cxt_t my_cxt;
#define dMY_CXT_SV dNOOP
#define dMY_CXT dNOOP
#define MY_CXT_INIT NOOP
#define MY_CXT my_cxt
#define pMY_CXT void
#define pMY_CXT_
#define _pMY_CXT
#define aMY_CXT
#define aMY_CXT_
#define _aMY_CXT
#endif
#endif /* START_MY_CXT */
#ifndef IVdf
# if IVSIZE == LONGSIZE
# define IVdf "ld"
# define UVuf "lu"
# define UVof "lo"
# define UVxf "lx"
# define UVXf "lX"
# else
# if IVSIZE == INTSIZE
# define IVdf "d"
# define UVuf "u"
# define UVof "o"
# define UVxf "x"
# define UVXf "X"
# endif
# endif
#endif
#ifndef NVef
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
# define NVef PERL_PRIeldbl
# define NVff PERL_PRIfldbl
# define NVgf PERL_PRIgldbl
# else
# define NVef "e"
# define NVff "f"
# define NVgf "g"
# endif
#endif
#ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */
# define AvFILLp AvFILL
#endif
#ifdef SvPVbyte
# if PERL_REVISION == 5 && PERL_VERSION < 7
/* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
# undef SvPVbyte
# define SvPVbyte(sv, lp) \
((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
static char *
my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
{
sv_utf8_downgrade(sv,0);
return SvPV(sv,*lp);
}
# endif
#else
# define SvPVbyte SvPV
#endif
#ifndef SvPV_nolen
# define SvPV_nolen(sv) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX(sv) : sv_2pv_nolen(sv))
static char *
sv_2pv_nolen(pTHX_ register SV *sv)
{
STRLEN n_a;
return sv_2pv(sv, &n_a);
}
#endif
#ifndef get_cv
# define get_cv(name,create) perl_get_cv(name,create)
#endif
#ifndef get_sv
# define get_sv(name,create) perl_get_sv(name,create)
#endif
#ifndef get_av
# define get_av(name,create) perl_get_av(name,create)
#endif
#ifndef get_hv
# define get_hv(name,create) perl_get_hv(name,create)
#endif
#ifndef call_argv
# define call_argv perl_call_argv
#endif
#ifndef call_method
# define call_method perl_call_method
#endif
#ifndef call_pv
# define call_pv perl_call_pv
#endif
#ifndef call_sv
# define call_sv perl_call_sv
#endif
#ifndef eval_pv
# define eval_pv perl_eval_pv
#endif
#ifndef eval_sv
# define eval_sv perl_eval_sv
#endif
#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
#endif
#ifndef PERL_SCAN_SILENT_ILLDIGIT
# define PERL_SCAN_SILENT_ILLDIGIT 0x04
#endif
#ifndef PERL_SCAN_ALLOW_UNDERSCORES
# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
#endif
#ifndef PERL_SCAN_DISALLOW_PREFIX
# define PERL_SCAN_DISALLOW_PREFIX 0x02
#endif
#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
#define I32_CAST
#else
#define I32_CAST (I32*)
#endif
#ifndef grok_hex
static UV _grok_hex (char *string, STRLEN *len, I32 *flags, NV *result) {
NV r = scan_hex(string, *len, I32_CAST len);
if (r > UV_MAX) {
*flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
if (result) *result = r;
return UV_MAX;
}
return (UV)r;
}
# define grok_hex(string, len, flags, result) \
_grok_hex((string), (len), (flags), (result))
#endif
#ifndef grok_oct
static UV _grok_oct (char *string, STRLEN *len, I32 *flags, NV *result) {
NV r = scan_oct(string, *len, I32_CAST len);
if (r > UV_MAX) {
*flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
if (result) *result = r;
return UV_MAX;
}
return (UV)r;
}
# define grok_oct(string, len, flags, result) \
_grok_oct((string), (len), (flags), (result))
#endif
#if !defined(grok_bin) && defined(scan_bin)
static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) {
NV r = scan_bin(string, *len, I32_CAST len);
if (r > UV_MAX) {
*flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
if (result) *result = r;
return UV_MAX;
}
return (UV)r;
}
# define grok_bin(string, len, flags, result) \
_grok_bin((string), (len), (flags), (result))
#endif
#ifndef IN_LOCALE
# define IN_LOCALE \
(PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
#endif
#ifndef IN_LOCALE_RUNTIME
# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
#endif
#ifndef IN_LOCALE_COMPILETIME
# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
#endif
#ifndef IS_NUMBER_IN_UV
# define IS_NUMBER_IN_UV 0x01
# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
# define IS_NUMBER_NOT_INT 0x04
# define IS_NUMBER_NEG 0x08
# define IS_NUMBER_INFINITY 0x10
# define IS_NUMBER_NAN 0x20
#endif
#ifndef grok_numeric_radix
# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send)
#define grok_numeric_radix Perl_grok_numeric_radix
bool
Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
if (PL_numeric_radix_sv && IN_LOCALE) {
STRLEN len;
char* radix = SvPV(PL_numeric_radix_sv, len);
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
}
}
#else
/* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix
* must manually be requested from locale.h */
#include <locale.h>
struct lconv *lc = localeconv();
char *radix = lc->decimal_point;
if (radix && IN_LOCALE) {
STRLEN len = strlen(radix);
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
}
}
#endif /* PERL_VERSION */
#endif /* USE_LOCALE_NUMERIC */
/* always try "." if numeric radix didn't match because
* we may have data from different locales mixed */
if (*sp < send && **sp == '.') {
++*sp;
return TRUE;
}
return FALSE;
}
#endif /* grok_numeric_radix */
#ifndef grok_number
#define grok_number Perl_grok_number
int
Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
const char *send = pv + len;
const UV max_div_10 = UV_MAX / 10;
const char max_mod_10 = UV_MAX % 10;
int numtype = 0;
int sawinf = 0;
int sawnan = 0;
while (s < send && isSPACE(*s))
s++;
if (s == send) {
return 0;
} else if (*s == '-') {
s++;
numtype = IS_NUMBER_NEG;
}
else if (*s == '+')
s++;
if (s == send)
return 0;
/* next must be digit or the radix separator or beginning of infinity */
if (isDIGIT(*s)) {
/* UVs are at least 32 bits, so the first 9 decimal digits cannot
overflow. */
UV value = *s - '0';
/* This construction seems to be more optimiser friendly.
(without it gcc does the isDIGIT test and the *s - '0' separately)
With it gcc on arm is managing 6 instructions (6 cycles) per digit.
In theory the optimiser could deduce how far to unroll the loop
before checking for overflow. */
if (++s < send) {
int digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
if (digit >= 0 && digit <= 9) {
value = value * 10 + digit;
if (++s < send) {
/* Now got 9 digits, so need to check
each time for overflow. */
digit = *s - '0';
while (digit >= 0 && digit <= 9
&& (value < max_div_10
|| (value == max_div_10
&& digit <= max_mod_10))) {
value = value * 10 + digit;
if (++s < send)
digit = *s - '0';
else
break;
}
if (digit >= 0 && digit <= 9
&& (s < send)) {
/* value overflowed.
skip the remaining digits, don't
worry about setting *valuep. */
do {
s++;
} while (s < send && isDIGIT(*s));
numtype |=
IS_NUMBER_GREATER_THAN_UV_MAX;
goto skip_value;
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
numtype |= IS_NUMBER_IN_UV;
if (valuep)
*valuep = value;
skip_value:
if (GROK_NUMERIC_RADIX(&s, send)) {
numtype |= IS_NUMBER_NOT_INT;
while (s < send && isDIGIT(*s)) /* optional digits after the radix */
s++;
}
}
else if (GROK_NUMERIC_RADIX(&s, send)) {
numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
/* no digits before the radix means we need digits after it */
if (s < send && isDIGIT(*s)) {
do {
s++;
} while (s < send && isDIGIT(*s));
if (valuep) {
/* integer approximation is valid - it's 0. */
*valuep = 0;
}
}
else
return 0;
} else if (*s == 'I' || *s == 'i') {
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
s++; if (s < send && (*s == 'I' || *s == 'i')) {
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
s++;
}
sawinf = 1;
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
return 0;
if (sawinf) {
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
} else if (sawnan) {
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
} else if (s < send) {
/* we can have an optional exponent part */
if (*s == 'e' || *s == 'E') {
/* The only flag we keep is sign. Blow away any "it's UV" */
numtype &= IS_NUMBER_NEG;
numtype |= IS_NUMBER_NOT_INT;
s++;
if (s < send && (*s == '-' || *s == '+'))
s++;
if (s < send && isDIGIT(*s)) {
do {
s++;
} while (s < send && isDIGIT(*s));
}
else
return 0;
}
}
while (s < send && isSPACE(*s))
s++;
if (s >= send)
return numtype;
if (len == 10 && memEQ(pv, "0 but true", 10)) {
if (valuep)
*valuep = 0;
return IS_NUMBER_IN_UV;
}
return 0;
}
#endif /* grok_number */
#ifndef PERL_MAGIC_sv
# define PERL_MAGIC_sv '\0'
#endif
#ifndef PERL_MAGIC_overload
# define PERL_MAGIC_overload 'A'
#endif
#ifndef PERL_MAGIC_overload_elem
# define PERL_MAGIC_overload_elem 'a'
#endif
#ifndef PERL_MAGIC_overload_table
# define PERL_MAGIC_overload_table 'c'
#endif
#ifndef PERL_MAGIC_bm
# define PERL_MAGIC_bm 'B'
#endif
#ifndef PERL_MAGIC_regdata
# define PERL_MAGIC_regdata 'D'
#endif
#ifndef PERL_MAGIC_regdatum
# define PERL_MAGIC_regdatum 'd'
#endif
#ifndef PERL_MAGIC_env
# define PERL_MAGIC_env 'E'
#endif
#ifndef PERL_MAGIC_envelem
# define PERL_MAGIC_envelem 'e'
#endif
#ifndef PERL_MAGIC_fm
# define PERL_MAGIC_fm 'f'
#endif
#ifndef PERL_MAGIC_regex_global
# define PERL_MAGIC_regex_global 'g'
#endif
#ifndef PERL_MAGIC_isa
# define PERL_MAGIC_isa 'I'
#endif
#ifndef PERL_MAGIC_isaelem
# define PERL_MAGIC_isaelem 'i'
#endif
#ifndef PERL_MAGIC_nkeys
# define PERL_MAGIC_nkeys 'k'
#endif
#ifndef PERL_MAGIC_dbfile
# define PERL_MAGIC_dbfile 'L'
#endif
#ifndef PERL_MAGIC_dbline
# define PERL_MAGIC_dbline 'l'
#endif
#ifndef PERL_MAGIC_mutex
# define PERL_MAGIC_mutex 'm'
#endif
#ifndef PERL_MAGIC_shared
# define PERL_MAGIC_shared 'N'
#endif
#ifndef PERL_MAGIC_shared_scalar
# define PERL_MAGIC_shared_scalar 'n'
#endif
#ifndef PERL_MAGIC_collxfrm
# define PERL_MAGIC_collxfrm 'o'
#endif
#ifndef PERL_MAGIC_tied
# define PERL_MAGIC_tied 'P'
#endif
#ifndef PERL_MAGIC_tiedelem
# define PERL_MAGIC_tiedelem 'p'
#endif
#ifndef PERL_MAGIC_tiedscalar
# define PERL_MAGIC_tiedscalar 'q'
#endif
#ifndef PERL_MAGIC_qr
# define PERL_MAGIC_qr 'r'
#endif
#ifndef PERL_MAGIC_sig
# define PERL_MAGIC_sig 'S'
#endif
#ifndef PERL_MAGIC_sigelem
# define PERL_MAGIC_sigelem 's'
#endif
#ifndef PERL_MAGIC_taint
# define PERL_MAGIC_taint 't'
#endif
#ifndef PERL_MAGIC_uvar
# define PERL_MAGIC_uvar 'U'
#endif
#ifndef PERL_MAGIC_uvar_elem
# define PERL_MAGIC_uvar_elem 'u'
#endif
#ifndef PERL_MAGIC_vstring
# define PERL_MAGIC_vstring 'V'
#endif
#ifndef PERL_MAGIC_vec
# define PERL_MAGIC_vec 'v'
#endif
#ifndef PERL_MAGIC_utf8
# define PERL_MAGIC_utf8 'w'
#endif
#ifndef PERL_MAGIC_substr
# define PERL_MAGIC_substr 'x'
#endif
#ifndef PERL_MAGIC_defelem
# define PERL_MAGIC_defelem 'y'
#endif
#ifndef PERL_MAGIC_glob
# define PERL_MAGIC_glob '*'
#endif
#ifndef PERL_MAGIC_arylen
# define PERL_MAGIC_arylen '#'
#endif
#ifndef PERL_MAGIC_pos
# define PERL_MAGIC_pos '.'
#endif
#ifndef PERL_MAGIC_backref
# define PERL_MAGIC_backref '<'
#endif
#ifndef PERL_MAGIC_ext
# define PERL_MAGIC_ext '~'
#endif
#endif /* _P_P_PORTABILITY_H_ */
/* End of File ppport.h */
IO-Epoll-0.02/t/ 0000755 0000000 0000000 00000000000 11150026374 0013253 5 ustar 00root root 0000000 0000000 IO-Epoll-0.02/t/IO-Epoll.t 0000644 0000000 0000000 00000003413 11150026374 0015021 0 ustar 00root root 0000000 0000000 #!/usr/bin/perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl IO-Epoll.t'
#########################
# change 'tests => 2' to 'tests => last_test_to_print';
use Test;
use Socket;
use strict;
BEGIN { plan tests => 9 };
use IO::Epoll;
ok(1); # If we made it this far, we're ok.
my $fail;
foreach my $constname (qw(
EPOLLERR EPOLLET EPOLLHUP EPOLLIN EPOLLMSG EPOLLOUT EPOLLPRI
EPOLLRDBAND EPOLLRDNORM EPOLLWRBAND EPOLLWRNORM EPOLL_CTL_ADD
EPOLL_CTL_DEL EPOLL_CTL_MOD)) {
next if (eval "my \$a = $constname; 1");
if ($@ =~ /^Your vendor has not defined IO::Epoll macro $constname/) {
print "# pass: $@";
} else {
print "# fail: $@";
$fail = 1;
}
}
if ($fail) {
print "not ok 2\n";
} else {
print "ok 2\n";
}
#########################
my $epoll = epoll_create(10);
if ($epoll < 0) {
print "# fail: epoll_create: $!\n";
print "not ok 3\n";
exit;
} else {
print "ok 3\n";
}
unless (socketpair(S1, S2, AF_UNIX, SOCK_STREAM, PF_UNSPEC)) {
print "not ok 4\n";
exit;
}
print "ok 4\n";
my $ret = epoll_ctl($epoll, EPOLL_CTL_ADD, fileno S1, EPOLLIN);
if ($ret < 0) {
print "not ok 5\n";
exit;
}
print "ok 5\n";
$ret = epoll_ctl($epoll, EPOLL_CTL_ADD, fileno S2, EPOLLIN);
if ($ret < 0) {
print "not ok 6\n";
exit;
}
print "ok 6\n";
$ret = epoll_ctl($epoll, EPOLL_CTL_ADD, 500, EPOLLIN);
if ($ret >= 0) {
print "not ok 7\n";
exit;
}
print "ok 7\n";
syswrite S1, "Hello\n";
my $events = epoll_wait($epoll, 10, 1000);
if (ref $events eq 'ARRAY' && @$events == 1) {
print "ok 8\n";
} else {
print "not ok 8\n";
}
if ($events->[0][0] == fileno S2 && $events->[0][1] & EPOLLIN) {
print "ok 9\n";
} else {
print "not ok 9\n";
}
IO-Epoll-0.02/t/IO-Poll-compat.t 0000755 0000000 0000000 00000003643 11150026374 0016145 0 ustar 00root root 0000000 0000000 #!/usr/bin/perl -w
# Cribbed this test from the IO::Poll tests in the main Perl distribution.
BEGIN {
unless(grep /blib/, @INC) {
chdir 't' if -d 't';
unshift(@INC, '../lib');
}
}
if ($^O eq 'mpeix') {
print "1..0 # Skip: broken on MPE/iX\n";
exit 0;
}
select(STDERR); $| = 1;
select(STDOUT); $| = 1;
print "1..11\n";
use IO::Handle;
use IO::Epoll qw(:compat);
use Time::HiRes qw( time );
my $poll = new IO::Epoll;
my $stdout = \*STDOUT;
my $dupout = IO::Handle->new_from_fd(fileno($stdout),"w");
$poll->mask($stdout => POLLOUT);
print "not "
unless $poll->mask($stdout) == POLLOUT;
print "ok 1\n";
$poll->mask($dupout => POLLPRI);
print "not "
unless $poll->mask($dupout) == POLLPRI;
print "ok 2\n";
$poll->poll(0.1);
if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' || $^O eq 'beos') {
print "ok 3 # skipped, doesn't work on non-socket fds\n";
print "ok 4 # skipped, doesn't work on non-socket fds\n";
}
else {
print "not "
unless $poll->events($stdout) == POLLOUT;
print "ok 3\n";
print "not "
if $poll->events($dupout);
print "ok 4\n";
}
my @h = $poll->handles;
print "not "
unless @h == 2;
print "ok 5\n";
$poll->remove($stdout);
@h = $poll->handles;
print "not "
unless @h == 1;
print "ok 6\n";
print "not "
if $poll->mask($stdout);
print "ok 7\n";
$poll->poll(0.1);
print "not "
if $poll->events($stdout);
print "ok 8\n";
$poll->remove($dupout);
print "not "
if $poll->handles;
print "ok 9\n";
my $stdin = \*STDIN;
$poll->mask($stdin => POLLIN);
$poll->remove($stdin);
close STDIN;
print "not "
if $poll->poll(0.1);
print "ok 10\n";
my $starttime = time();
$poll->poll( 1.000 );
my $duration = time() - $starttime;
if( $duration < 0.9 or $duration > 1.5 ) {
print "not ok 11 # poll(1.000) took ";
print "more than 1.5 seconds ($duration)\n" if $duration > 1.5;
print "less than 0.9 seconds ($duration)\n" if $duration < 0.9;
}
else {
print "ok 11\n";
}
IO-Epoll-0.02/t/IO-Ppoll-compat.t 0000644 0000000 0000000 00000002334 11150026374 0016316 0 ustar 00root root 0000000 0000000 #!/usr/bin/perl -w
use strict;
use Test::More tests => 10;
use IO::Epoll;
use POSIX qw(
sigprocmask SIG_BLOCK
SIGHUP SIGTERM SIGUSR1 SIGUSR2
EINTR
);
my $epoll = IO::Epoll->new();
ok( !$epoll->sigmask_ismember( SIGHUP ), 'SIGHUP not in initial set' );
$epoll->sigmask_add( SIGHUP );
ok( $epoll->sigmask_ismember( SIGHUP ), 'SIGHUP now in set' );
$epoll->sigmask_del( SIGHUP );
ok( !$epoll->sigmask_ismember( SIGHUP ), 'SIGHUP no longer in set' );
my $SIGHUP_count = 0;
$SIG{HUP} = sub { $SIGHUP_count++ };
kill SIGHUP, $$;
is( $SIGHUP_count, 1, 'Caught SIGHUP before sigprocmask' );
sigprocmask( SIG_BLOCK, POSIX::SigSet->new( SIGHUP ) );
kill SIGHUP, $$;
is( $SIGHUP_count, 1, 'Not caught SIGHUP after sigprocmask' );
my $ret = $epoll->poll( 0.1 );
my $dollarbang = $!+0;
is( $ret, -1, 'poll() returns undef' );
is( $dollarbang, EINTR, 'poll() failed with EINTR' );
is( $SIGHUP_count, 2, 'Caught SIGHUP after poll' );
sigprocmask( SIG_BLOCK, POSIX::SigSet->new( SIGTERM ) );
$epoll->sigmask_add( SIGTERM );
my $SIGTERM_count = 0;
$SIG{TERM} = sub { $SIGTERM_count++ };
kill SIGTERM, $$;
$ret = $epoll->poll( 0.1 );
is( $ret, 0, 'poll() returns 0' );
is( $SIGTERM_count, 0, 'Not caught SIGTERM after poll()' );