123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504 |
- package POSIX;
- use strict;
- use warnings;
- our ($AUTOLOAD, %SIGRT);
- our $VERSION = '1.53_01';
- require XSLoader;
- use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD
- F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND
- O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC
- O_WRONLY SEEK_CUR SEEK_END SEEK_SET
- S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG
- S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
- S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR);
- my $loaded;
- sub import {
- my $pkg = shift;
- load_imports() unless $loaded++;
- # Grandfather old foo_h form to new :foo_h form
- s/^(?=\w+_h$)/:/ for my @list = @_;
- local $Exporter::ExportLevel = 1;
- Exporter::import($pkg,@list);
- }
- sub croak { require Carp; goto &Carp::croak }
- sub usage { croak "Usage: POSIX::$_[0]" }
- XSLoader::load();
- my %replacement = (
- atexit => 'END {}',
- atof => undef,
- atoi => undef,
- atol => undef,
- bsearch => \'not supplied',
- calloc => undef,
- clearerr => 'IO::Handle::clearerr',
- div => '/, % and int',
- execl => undef,
- execle => undef,
- execlp => undef,
- execv => undef,
- execve => undef,
- execvp => undef,
- fclose => 'IO::Handle::close',
- fdopen => 'IO::Handle::new_from_fd',
- feof => 'IO::Handle::eof',
- ferror => 'IO::Handle::error',
- fflush => 'IO::Handle::flush',
- fgetc => 'IO::Handle::getc',
- fgetpos => 'IO::Seekable::getpos',
- fgets => 'IO::Handle::gets',
- fileno => 'IO::Handle::fileno',
- fopen => 'IO::File::open',
- fprintf => 'printf',
- fputc => 'print',
- fputs => 'print',
- fread => 'read',
- free => undef,
- freopen => 'open',
- fscanf => '<> and regular expressions',
- fseek => 'IO::Seekable::seek',
- fsetpos => 'IO::Seekable::setpos',
- fsync => 'IO::Handle::sync',
- ftell => 'IO::Seekable::tell',
- fwrite => 'print',
- labs => 'abs',
- ldiv => '/, % and int',
- longjmp => 'die',
- malloc => undef,
- memchr => 'index()',
- memcmp => 'eq',
- memcpy => '=',
- memmove => '=',
- memset => 'x',
- offsetof => undef,
- putc => 'print',
- putchar => 'print',
- puts => 'print',
- qsort => 'sort',
- rand => \'non-portable, use Perl\'s rand instead',
- realloc => undef,
- scanf => '<> and regular expressions',
- setbuf => 'IO::Handle::setbuf',
- setjmp => 'eval {}',
- setvbuf => 'IO::Handle::setvbuf',
- siglongjmp => 'die',
- sigsetjmp => 'eval {}',
- srand => \'not supplied; refer to Perl\'s srand documentation',
- sscanf => 'regular expressions',
- strcat => '.=',
- strchr => 'index()',
- strcmp => 'eq',
- strcpy => '=',
- strcspn => 'regular expressions',
- strlen => 'length',
- strncat => '.=',
- strncmp => 'eq',
- strncpy => '=',
- strpbrk => undef,
- strrchr => 'rindex()',
- strspn => undef,
- strtok => undef,
- tmpfile => 'IO::File::new_tmpfile',
- ungetc => 'IO::Handle::ungetc',
- vfprintf => undef,
- vprintf => undef,
- vsprintf => undef,
- );
- my %reimpl = (
- assert => 'expr => croak "Assertion failed" if !$_[0]',
- tolower => 'string => lc($_[0])',
- toupper => 'string => uc($_[0])',
- closedir => 'dirhandle => CORE::closedir($_[0])',
- opendir => 'directory => my $dh; CORE::opendir($dh, $_[0]) ? $dh : undef',
- readdir => 'dirhandle => CORE::readdir($_[0])',
- rewinddir => 'dirhandle => CORE::rewinddir($_[0])',
- errno => '$! + 0',
- creat => 'filename, mode => &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1])',
- fcntl => 'filehandle, cmd, arg => CORE::fcntl($_[0], $_[1], $_[2])',
- getgrgid => 'gid => CORE::getgrgid($_[0])',
- getgrnam => 'name => CORE::getgrnam($_[0])',
- atan2 => 'x, y => CORE::atan2($_[0], $_[1])',
- cos => 'x => CORE::cos($_[0])',
- exp => 'x => CORE::exp($_[0])',
- fabs => 'x => CORE::abs($_[0])',
- log => 'x => CORE::log($_[0])',
- pow => 'x, exponent => $_[0] ** $_[1]',
- sin => 'x => CORE::sin($_[0])',
- sqrt => 'x => CORE::sqrt($_[0])',
- getpwnam => 'name => CORE::getpwnam($_[0])',
- getpwuid => 'uid => CORE::getpwuid($_[0])',
- kill => 'pid, sig => CORE::kill $_[1], $_[0]',
- raise => 'sig => CORE::kill $_[0], $$; # Is this good enough',
- getc => 'handle => CORE::getc($_[0])',
- getchar => 'CORE::getc(STDIN)',
- gets => 'scalar <STDIN>',
- remove => 'filename => (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0])',
- rename => 'oldfilename, newfilename => CORE::rename($_[0], $_[1])',
- rewind => 'filehandle => CORE::seek($_[0],0,0)',
- abs => 'x => CORE::abs($_[0])',
- exit => 'status => CORE::exit($_[0])',
- getenv => 'name => $ENV{$_[0]}',
- system => 'command => CORE::system($_[0])',
- strerror => 'errno => BEGIN { local $!; require locale; locale->import} my $e = $_[0] + 0; local $!; $! = $e; "$!"',
- strstr => 'big, little => CORE::index($_[0], $_[1])',
- chmod => 'mode, filename => CORE::chmod($_[0], $_[1])',
- fstat => 'fd => CORE::open my $dup, "<&", $_[0]; CORE::stat($dup)', # Gross.
- mkdir => 'directoryname, mode => CORE::mkdir($_[0], $_[1])',
- stat => 'filename => CORE::stat($_[0])',
- umask => 'mask => CORE::umask($_[0])',
- wait => 'CORE::wait()',
- waitpid => 'pid, options => CORE::waitpid($_[0], $_[1])',
- gmtime => 'time => CORE::gmtime($_[0])',
- localtime => 'time => CORE::localtime($_[0])',
- time => 'CORE::time',
- alarm => 'seconds => CORE::alarm($_[0])',
- chdir => 'directory => CORE::chdir($_[0])',
- chown => 'uid, gid, filename => CORE::chown($_[0], $_[1], $_[2])',
- fork => 'CORE::fork',
- getegid => '$) + 0',
- geteuid => '$> + 0',
- getgid => '$( + 0',
- getgroups => 'my %seen; grep !$seen{$_}++, split " ", $)',
- getlogin => 'CORE::getlogin()',
- getpgrp => 'CORE::getpgrp',
- getpid => '$$',
- getppid => 'CORE::getppid',
- getuid => '$<',
- isatty => 'filehandle => -t $_[0]',
- link => 'oldfilename, newfilename => CORE::link($_[0], $_[1])',
- rmdir => 'directoryname => CORE::rmdir($_[0])',
- unlink => 'filename => CORE::unlink($_[0])',
- utime => 'filename, atime, mtime => CORE::utime($_[1], $_[2], $_[0])',
- );
- eval join ';', map "sub $_", keys %replacement, keys %reimpl;
- sub AUTOLOAD {
- my ($func) = ($AUTOLOAD =~ /.*::(.*)/);
- die "POSIX.xs has failed to load\n" if $func eq 'constant';
- if (my $code = $reimpl{$func}) {
- my ($num, $arg) = (0, '');
- if ($code =~ s/^(.*?) *=> *//) {
- $arg = $1;
- $num = 1 + $arg =~ tr/,//;
- }
- # no warnings to be consistent with the old implementation, where each
- # function was in its own little AutoSplit world:
- eval qq{ sub $func {
- no warnings;
- usage "$func($arg)" if \@_ != $num;
- $code
- } };
- no strict;
- goto &$AUTOLOAD;
- }
- if (exists $replacement{$func}) {
- my $how = $replacement{$func};
- croak "Unimplemented: POSIX::$func() is C-specific, stopped"
- unless defined $how;
- croak "Unimplemented: POSIX::$func() is $$how" if ref $how;
- croak "Use method $how() instead of POSIX::$func()" if $how =~ /::/;
- croak "Unimplemented: POSIX::$func() is C-specific: use $how instead";
- }
- constant($func);
- }
- sub perror {
- print STDERR "@_: " if @_;
- print STDERR $!,"\n";
- }
- sub printf {
- usage "printf(pattern, args...)" if @_ < 1;
- CORE::printf STDOUT @_;
- }
- sub sprintf {
- usage "sprintf(pattern, args...)" if @_ == 0;
- CORE::sprintf(shift,@_);
- }
- sub load_imports {
- my %default_export_tags = (
- assert_h => [qw(assert NDEBUG)],
- ctype_h => [qw(isalnum isalpha iscntrl isdigit isgraph islower
- isprint ispunct isspace isupper isxdigit tolower toupper)],
- dirent_h => [],
- errno_h => [qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT EAGAIN
- EALREADY EBADF EBADMSG EBUSY ECANCELED ECHILD ECONNABORTED
- ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT EEXIST
- EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EIDRM EILSEQ EINPROGRESS
- EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE
- ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS
- ENODATA ENODEV ENOENT ENOEXEC ENOLCK ENOLINK ENOMEM ENOMSG
- ENOPROTOOPT ENOSPC ENOSR ENOSTR ENOSYS ENOTBLK ENOTCONN ENOTDIR
- ENOTEMPTY ENOTRECOVERABLE ENOTSOCK ENOTSUP ENOTTY ENXIO
- EOPNOTSUPP EOTHER EOVERFLOW EOWNERDEAD EPERM EPFNOSUPPORT EPIPE
- EPROCLIM EPROTO EPROTONOSUPPORT EPROTOTYPE ERANGE EREMOTE
- ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESTALE
- ETIME ETIMEDOUT ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK EXDEV
- errno)],
- fcntl_h => [qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK
- F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK
- O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK
- O_RDONLY O_RDWR O_TRUNC O_WRONLY
- creat
- SEEK_CUR SEEK_END SEEK_SET
- S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
- S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID
- S_IWGRP S_IWOTH S_IWUSR)],
- float_h => [qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG
- DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP
- DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
- FLT_DIG FLT_EPSILON FLT_MANT_DIG
- FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP
- FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP
- FLT_RADIX FLT_ROUNDS
- LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG
- LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP
- LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)],
- grp_h => [],
- limits_h => [qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX
- INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON
- MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX
- PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN
- SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX
- ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX
- _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT
- _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX
- _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
- _POSIX_STREAM_MAX _POSIX_TZNAME_MAX)],
- locale_h => [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MESSAGES
- LC_MONETARY LC_NUMERIC LC_TIME NULL
- localeconv setlocale)],
- math_h => [qw(FP_ILOGB0 FP_ILOGBNAN FP_INFINITE FP_NAN FP_NORMAL
- FP_SUBNORMAL FP_ZERO
- M_1_PI M_2_PI M_2_SQRTPI M_E M_LN10 M_LN2 M_LOG10E M_LOG2E
- M_PI M_PI_2 M_PI_4 M_SQRT1_2 M_SQRT2
- HUGE_VAL INFINITY NAN
- acos asin atan ceil cosh fabs floor fmod
- frexp ldexp log10 modf pow sinh tan tanh)],
- pwd_h => [],
- setjmp_h => [qw(longjmp setjmp siglongjmp sigsetjmp)],
- signal_h => [qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
- SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
- SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
- SIGPIPE %SIGRT SIGRTMIN SIGRTMAX SIGQUIT SIGSEGV SIGSTOP
- SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIGBUS
- SIGPOLL SIGPROF SIGSYS SIGTRAP SIGURG SIGVTALRM SIGXCPU SIGXFSZ
- SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
- raise sigaction signal sigpending sigprocmask sigsuspend)],
- stdarg_h => [],
- stddef_h => [qw(NULL offsetof)],
- stdio_h => [qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid
- L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET
- STREAM_MAX TMP_MAX stderr stdin stdout
- clearerr fclose fdopen feof ferror fflush fgetc fgetpos
- fgets fopen fprintf fputc fputs fread freopen
- fscanf fseek fsetpos ftell fwrite getchar gets
- perror putc putchar puts remove rewind
- scanf setbuf setvbuf sscanf tmpfile tmpnam
- ungetc vfprintf vprintf vsprintf)],
- stdlib_h => [qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX
- abort atexit atof atoi atol bsearch calloc div
- free getenv labs ldiv malloc mblen mbstowcs mbtowc
- qsort realloc strtod strtol strtoul wcstombs wctomb)],
- string_h => [qw(NULL memchr memcmp memcpy memmove memset strcat
- strchr strcmp strcoll strcpy strcspn strerror strlen
- strncat strncmp strncpy strpbrk strrchr strspn strstr
- strtok strxfrm)],
- sys_stat_h => [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
- S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG
- S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
- fstat mkfifo)],
- sys_times_h => [],
- sys_types_h => [],
- sys_utsname_h => [qw(uname)],
- sys_wait_h => [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
- WNOHANG WSTOPSIG WTERMSIG WUNTRACED)],
- termios_h => [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400
- B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL
- CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK
- ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR
- INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST
- PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION
- TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
- TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART
- VSTOP VSUSP VTIME
- cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain
- tcflow tcflush tcgetattr tcsendbreak tcsetattr )],
- time_h => [qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
- difftime mktime strftime tzset tzname)],
- unistd_h => [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
- STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
- _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON
- _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX
- _PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED
- _POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS
- _POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX
- _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
- _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS
- _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
- _exit access ctermid cuserid
- dup2 dup execl execle execlp execv execve execvp
- fpathconf fsync getcwd getegid geteuid getgid getgroups
- getpid getuid isatty lseek pathconf pause setgid setpgid
- setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
- utime_h => [],
- );
- my %other_export_tags = (
- fenv_h => [qw(
- FE_DOWNWARD FE_TONEAREST FE_TOWARDZERO FE_UPWARD fegetround fesetround
- )],
- math_h_c99 => [ @{$default_export_tags{math_h}}, qw(
- Inf NaN acosh asinh atanh cbrt copysign erf erfc exp2 expm1 fdim fma
- fmax fmin fpclassify hypot ilogb isfinite isgreater isgreaterequal
- isinf isless islessequal islessgreater isnan isnormal isunordered j0 j1
- jn lgamma log1p log2 logb lrint nan nearbyint nextafter nexttoward
- remainder remquo rint round scalbn signbit tgamma trunc y0 y1 yn
- )],
- stdlib_h_c99 => [ @{$default_export_tags{stdlib_h}}, 'strtold' ],
- );
- {
- # De-duplicate the export list:
- my ( %export, %export_ok );
- @export {map {@$_} values %default_export_tags} = ();
- @export_ok{map {@$_} values %other_export_tags} = ();
- # Doing the de-dup with a temporary hash has the advantage that the SVs in
- # @EXPORT are actually shared hash key scalars, which will save some memory.
- our @EXPORT = keys %export;
- our @EXPORT_OK = (qw(close lchown nice open pipe read sleep times write
- printf sprintf),
- grep {!exists $export{$_}} keys %reimpl, keys %replacement, keys %export_ok);
- our %EXPORT_TAGS = ( %default_export_tags, %other_export_tags );
- }
- require Exporter;
- }
- package POSIX::SigAction;
- sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0, SAFE => 0}, $_[0] }
- sub handler { $_[0]->{HANDLER} = $_[1] if @_ > 1; $_[0]->{HANDLER} };
- sub mask { $_[0]->{MASK} = $_[1] if @_ > 1; $_[0]->{MASK} };
- sub flags { $_[0]->{FLAGS} = $_[1] if @_ > 1; $_[0]->{FLAGS} };
- sub safe { $_[0]->{SAFE} = $_[1] if @_ > 1; $_[0]->{SAFE} };
- {
- package POSIX::SigSet;
- # This package is here entirely to make sure that POSIX::SigSet is seen by the
- # PAUSE indexer, so that it will always be clearly indexed in core. This is to
- # prevent the accidental case where a third-party distribution can accidentally
- # claim the POSIX::SigSet package, as occurred in 2011-12. -- rjbs, 2011-12-30
- }
- package POSIX::SigRt;
- require Tie::Hash;
- our @ISA = 'Tie::StdHash';
- our ($_SIGRTMIN, $_SIGRTMAX, $_sigrtn);
- our $SIGACTION_FLAGS = 0;
- sub _init {
- $_SIGRTMIN = &POSIX::SIGRTMIN;
- $_SIGRTMAX = &POSIX::SIGRTMAX;
- $_sigrtn = $_SIGRTMAX - $_SIGRTMIN;
- }
- sub _croak {
- &_init unless defined $_sigrtn;
- die "POSIX::SigRt not available" unless defined $_sigrtn && $_sigrtn > 0;
- }
- sub _getsig {
- &_croak;
- my $rtsig = $_[0];
- # Allow (SIGRT)?MIN( + n)?, a common idiom when doing these things in C.
- $rtsig = $_SIGRTMIN + ($1 || 0)
- if $rtsig =~ /^(?:(?:SIG)?RT)?MIN(\s*\+\s*(\d+))?$/;
- return $rtsig;
- }
- sub _exist {
- my $rtsig = _getsig($_[1]);
- my $ok = $rtsig >= $_SIGRTMIN && $rtsig <= $_SIGRTMAX;
- ($rtsig, $ok);
- }
- sub _check {
- my ($rtsig, $ok) = &_exist;
- die "No POSIX::SigRt signal $_[1] (valid range SIGRTMIN..SIGRTMAX, or $_SIGRTMIN..$_SIGRTMAX)"
- unless $ok;
- return $rtsig;
- }
- sub new {
- my ($rtsig, $handler, $flags) = @_;
- my $sigset = POSIX::SigSet->new($rtsig);
- my $sigact = POSIX::SigAction->new($handler, $sigset, $flags);
- POSIX::sigaction($rtsig, $sigact);
- }
- sub EXISTS { &_exist }
- sub FETCH { my $rtsig = &_check;
- my $oa = POSIX::SigAction->new();
- POSIX::sigaction($rtsig, undef, $oa);
- return $oa->{HANDLER} }
- sub STORE { my $rtsig = &_check; new($rtsig, $_[2], $SIGACTION_FLAGS) }
- sub DELETE { delete $SIG{ &_check } }
- sub CLEAR { &_exist; delete @SIG{ &POSIX::SIGRTMIN .. &POSIX::SIGRTMAX } }
- sub SCALAR { &_croak; $_sigrtn + 1 }
- tie %POSIX::SIGRT, 'POSIX::SigRt';
- # and the expression on the line above is true, so we return true.
|