[perl5.git] / ext / POSIX / lib / POSIX.pm

package POSIX;
use strict;
use warnings;

our ($AUTOLOAD, %SIGRT);

our $VERSION = '1.27';

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 => local $! = $_[0]; "$!"',
    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])',
    sleep     => 'seconds => $_[0] - CORE::sleep($_[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 =~ /.*::(.*)/);

    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 {
our %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 EBUSY ECHILD ECONNABORTED
		ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
		EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
		EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
		EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
		ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
		ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
		ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
		EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
		ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
		ESPIPE ESRCH ESTALE 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(HUGE_VAL 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 =>	[],
);

# Exporter::export_tags();
{
  # De-duplicate the export list: 
  my %export;
  @export{map {@$_} values %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 times write
		       printf sprintf),
		    grep {!exists $export{$_}} keys %reimpl, keys %replacement);
}

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::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.
Commit	Line	Data
a0d0e21e	1	package POSIX;
e9b37efe NC	2	use strict;
e9b37efe NC	3	use warnings;
a0d0e21e	4
122efcc9	5	our ($AUTOLOAD, %SIGRT);
73c78b0a	6
e08f19f5	7	our $VERSION = '1.27';
d5a0d2f9	8
da4061d3	9	require XSLoader;
a0d0e21e	10
33fb14dc NC	11	use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD
	12	F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND
	13	O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC
a5d75221	14	O_WRONLY SEEK_CUR SEEK_END SEEK_SET
9b68a132	15	S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG
a5d75221 NC	16	S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
a5d75221 NC	17	S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR);
33fb14dc	18
66fbe9e2 GS	19	my $loaded;
66fbe9e2 GS	20
a0d0e21e	21	sub import {
8fe37eed AP	22	my $pkg = shift;
8fe37eed AP	23
66fbe9e2	24	load_imports() unless $loaded++;
8fe37eed AP	25
	26	# Grandfather old foo_h form to new :foo_h form
	27	s/^(?=\w+_h$)/:/ for my @list = @_;
	28
a0d0e21e	29	local $Exporter::ExportLevel = 1;
8fe37eed	30	Exporter::import($pkg,@list);
a0d0e21e LW	31	}
a0d0e21e LW	32
66fbe9e2	33	sub croak { require Carp; goto &Carp::croak }
122efcc9	34	sub usage { croak "Usage: POSIX::$_[0]" }
4633a7c4	35
da4061d3	36	XSLoader::load();
4633a7c4	37
8fe37eed AP	38	my %replacement = (
	39	atexit => 'END {}',
	40	atof => undef,
	41	atoi => undef,
	42	atol => undef,
	43	bsearch => \'not supplied',
	44	calloc => undef,
	45	clearerr => 'IO::Handle::clearerr',
	46	div => '/, % and int',
	47	execl => undef,
	48	execle => undef,
	49	execlp => undef,
	50	execv => undef,
	51	execve => undef,
	52	execvp => undef,
	53	fclose => 'IO::Handle::close',
	54	fdopen => 'IO::Handle::new_from_fd',
	55	feof => 'IO::Handle::eof',
	56	ferror => 'IO::Handle::error',
	57	fflush => 'IO::Handle::flush',
	58	fgetc => 'IO::Handle::getc',
	59	fgetpos => 'IO::Seekable::getpos',
	60	fgets => 'IO::Handle::gets',
	61	fileno => 'IO::Handle::fileno',
	62	fopen => 'IO::File::open',
	63	fprintf => 'printf',
	64	fputc => 'print',
	65	fputs => 'print',
	66	fread => 'read',
	67	free => undef,
	68	freopen => 'open',
	69	fscanf => '<> and regular expressions',
	70	fseek => 'IO::Seekable::seek',
	71	fsetpos => 'IO::Seekable::setpos',
	72	fsync => 'IO::Handle::sync',
	73	ftell => 'IO::Seekable::tell',
	74	fwrite => 'print',
	75	labs => 'abs',
	76	ldiv => '/, % and int',
	77	longjmp => 'die',
	78	malloc => undef,
	79	memchr => 'index()',
	80	memcmp => 'eq',
	81	memcpy => '=',
	82	memmove => '=',
	83	memset => 'x',
	84	offsetof => undef,
	85	putc => 'print',
	86	putchar => 'print',
	87	puts => 'print',
	88	qsort => 'sort',
	89	rand => \'non-portable, use Perl\'s rand instead',
	90	realloc => undef,
	91	scanf => '<> and regular expressions',
	92	setbuf => 'IO::Handle::setbuf',
	93	setjmp => 'eval {}',
	94	setvbuf => 'IO::Handle::setvbuf',
	95	siglongjmp => 'die',
	96	sigsetjmp => 'eval {}',
96927498	97	srand => \'not supplied; refer to Perl\'s srand documentation',
8fe37eed AP	98	sscanf => 'regular expressions',
	99	strcat => '.=',
	100	strchr => 'index()',
	101	strcmp => 'eq',
	102	strcpy => '=',
	103	strcspn => 'regular expressions',
	104	strlen => 'length',
	105	strncat => '.=',
	106	strncmp => 'eq',
	107	strncpy => '=',
	108	strpbrk => undef,
	109	strrchr => 'rindex()',
	110	strspn => undef,
	111	strtok => undef,
	112	tmpfile => 'IO::File::new_tmpfile',
	113	ungetc => 'IO::Handle::ungetc',
	114	vfprintf => undef,
	115	vprintf => undef,
	116	vsprintf => undef,
	117	);
	118
122efcc9 AP	119	my %reimpl = (
	120	assert => 'expr => croak "Assertion failed" if !$_[0]',
	121	tolower => 'string => lc($_[0])',
	122	toupper => 'string => uc($_[0])',
	123	closedir => 'dirhandle => CORE::closedir($_[0])',
	124	opendir => 'directory => my $dh; CORE::opendir($dh, $_[0]) ? $dh : undef',
	125	readdir => 'dirhandle => CORE::readdir($_[0])',
	126	rewinddir => 'dirhandle => CORE::rewinddir($_[0])',
	127	errno => '$! + 0',
	128	creat => 'filename, mode => &open($_[0], &O_WRONLY \| &O_CREAT \| &O_TRUNC, $_[1])',
	129	fcntl => 'filehandle, cmd, arg => CORE::fcntl($_[0], $_[1], $_[2])',
	130	getgrgid => 'gid => CORE::getgrgid($_[0])',
	131	getgrnam => 'name => CORE::getgrnam($_[0])',
	132	atan2 => 'x, y => CORE::atan2($_[0], $_[1])',
	133	cos => 'x => CORE::cos($_[0])',
	134	exp => 'x => CORE::exp($_[0])',
	135	fabs => 'x => CORE::abs($_[0])',
	136	log => 'x => CORE::log($_[0])',
	137	pow => 'x, exponent => $_[0] ** $_[1]',
	138	sin => 'x => CORE::sin($_[0])',
	139	sqrt => 'x => CORE::sqrt($_[0])',
	140	getpwnam => 'name => CORE::getpwnam($_[0])',
	141	getpwuid => 'uid => CORE::getpwuid($_[0])',
	142	kill => 'pid, sig => CORE::kill $_[1], $_[0]',
	143	raise => 'sig => CORE::kill $_[0], $$; # Is this good enough',
	144	getc => 'handle => CORE::getc($_[0])',
	145	getchar => 'CORE::getc(STDIN)',
	146	gets => 'scalar <STDIN>',
	147	remove => 'filename => (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0])',
	148	rename => 'oldfilename, newfilename => CORE::rename($_[0], $_[1])',
	149	rewind => 'filehandle => CORE::seek($_[0],0,0)',
	150	abs => 'x => CORE::abs($_[0])',
	151	exit => 'status => CORE::exit($_[0])',
	152	getenv => 'name => $ENV{$_[0]}',
	153	system => 'command => CORE::system($_[0])',
	154	strerror => 'errno => local $! = $_[0]; "$!"',
	155	strstr => 'big, little => CORE::index($_[0], $_[1])',
	156	chmod => 'mode, filename => CORE::chmod($_[0], $_[1])',
	157	fstat => 'fd => CORE::open my $dup, "<&", $_[0]; CORE::stat($dup)', # Gross.
	158	mkdir => 'directoryname, mode => CORE::mkdir($_[0], $_[1])',
	159	stat => 'filename => CORE::stat($_[0])',
	160	umask => 'mask => CORE::umask($_[0])',
	161	wait => 'CORE::wait()',
	162	waitpid => 'pid, options => CORE::waitpid($_[0], $_[1])',
	163	gmtime => 'time => CORE::gmtime($_[0])',
	164	localtime => 'time => CORE::localtime($_[0])',
	165	time => 'CORE::time',
	166	alarm => 'seconds => CORE::alarm($_[0])',
	167	chdir => 'directory => CORE::chdir($_[0])',
	168	chown => 'uid, gid, filename => CORE::chown($_[0], $_[1], $_[2])',
	169	fork => 'CORE::fork',
	170	getegid => '$) + 0',
	171	geteuid => '$> + 0',
	172	getgid => '$( + 0',
	173	getgroups => 'my %seen; grep !$seen{$_}++, split " ", $)',
	174	getlogin => 'CORE::getlogin()',
	175	getpgrp => 'CORE::getpgrp',
	176	getpid => '$$',
	177	getppid => 'CORE::getppid',
	178	getuid => '$<',
	179	isatty => 'filehandle => -t $_[0]',
	180	link => 'oldfilename, newfilename => CORE::link($_[0], $_[1])',
	181	rmdir => 'directoryname => CORE::rmdir($_[0])',
	182	sleep => 'seconds => $_[0] - CORE::sleep($_[0])',
183	unlink => 'filename => CORE::unlink($_[0])',
184	utime => 'filename, atime, mtime => CORE::utime($_[1], $_[2], $_[0])',
185	);
8fe37eed	186
122efcc9	187	eval join ';', map "sub $_", keys %replacement, keys %reimpl;
8fe37eed	188
122efcc9	189	sub AUTOLOAD {
8fe37eed AP	190	my ($func) = ($AUTOLOAD =~ /.::(.)/);
8fe37eed AP	191
8dad66f8	192	if (my $code = $reimpl{$func}) {
122efcc9 AP	193	my ($num, $arg) = (0, '');
	194	if ($code =~ s/^(.?) => *//) {
	195	$arg = $1;
	196	$num = 1 + $arg =~ tr/,//;
	197	}
	198	# no warnings to be consistent with the old implementation, where each
	199	# function was in its own little AutoSplit world:
	200	eval qq{ sub $func {
	201	no warnings;
	202	usage "$func($arg)" if \@_ != $num;
	203	$code
	204	} };
	205	no strict;
	206	goto &$AUTOLOAD;
	207	}
8fe37eed AP	208	if (exists $replacement{$func}) {
	209	my $how = $replacement{$func};
	210	croak "Unimplemented: POSIX::$func() is C-specific, stopped"
	211	unless defined $how;
	212	croak "Unimplemented: POSIX::$func() is $$how" if ref $how;
11e7c26f	213	croak "Use method $how() instead of POSIX::$func()" if $how =~ /::/;
96927498	214	croak "Unimplemented: POSIX::$func() is C-specific: use $how instead";
8fe37eed AP	215	}
8fe37eed AP	216
8fe37eed	217	constant($func);
a0d0e21e LW	218	}
a0d0e21e LW	219
a0d0e21e LW	220	sub perror {
	221	print STDERR "@_: " if @_;
	222	print STDERR $!,"\n";
	223	}
	224
	225	sub printf {
	226	usage "printf(pattern, args...)" if @_ < 1;
b56ec344	227	CORE::printf STDOUT @_;
a0d0e21e LW	228	}
a0d0e21e LW	229
a0d0e21e	230	sub sprintf {
c43a6b96	231	usage "sprintf(pattern, args...)" if @_ == 0;
b56ec344	232	CORE::sprintf(shift,@_);
a0d0e21e LW	233	}
a0d0e21e LW	234
66fbe9e2	235	sub load_imports {
b0ac411b	236	our %EXPORT_TAGS = (
66fbe9e2 GS	237
	238	assert_h => [qw(assert NDEBUG)],
	239
	240	ctype_h => [qw(isalnum isalpha iscntrl isdigit isgraph islower
	241	isprint ispunct isspace isupper isxdigit tolower toupper)],
	242
d4742b2c	243	dirent_h => [],
66fbe9e2 GS	244
	245	errno_h => [qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
	246	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
	247	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
	248	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
	249	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
	250	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
	251	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
	252	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
	253	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
	254	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
	255	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
	256	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
	257	EUSERS EWOULDBLOCK EXDEV errno)],
	258
	259	fcntl_h => [qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK
	260	F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK
	261	O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK
	262	O_RDONLY O_RDWR O_TRUNC O_WRONLY
	263	creat
	264	SEEK_CUR SEEK_END SEEK_SET
	265	S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
	266	S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID
	267	S_IWGRP S_IWOTH S_IWUSR)],
	268
	269	float_h => [qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG
	270	DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP
	271	DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
	272	FLT_DIG FLT_EPSILON FLT_MANT_DIG
	273	FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP
	274	FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP
	275	FLT_RADIX FLT_ROUNDS
	276	LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG
	277	LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP
	278	LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)],
	279
d4742b2c	280	grp_h => [],
66fbe9e2 GS	281
	282	limits_h => [qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX
	283	INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON
	284	MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX
	285	PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN
	286	SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX
	287	ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX
	288	_POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT
	289	_POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX
	290	_POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
	291	_POSIX_STREAM_MAX _POSIX_TZNAME_MAX)],
	292
83f427f7 JH	293	locale_h => [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MESSAGES
	294	LC_MONETARY LC_NUMERIC LC_TIME NULL
	295	localeconv setlocale)],
66fbe9e2 GS	296
	297	math_h => [qw(HUGE_VAL acos asin atan ceil cosh fabs floor fmod
	298	frexp ldexp log10 modf pow sinh tan tanh)],
	299
d4742b2c	300	pwd_h => [],
66fbe9e2 GS	301
	302	setjmp_h => [qw(longjmp setjmp siglongjmp sigsetjmp)],
	303
	304	signal_h => [qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
	305	SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
	306	SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
3609ea0d	307	SIGPIPE %SIGRT SIGRTMIN SIGRTMAX SIGQUIT SIGSEGV SIGSTOP
ee25ad77 FR	308	SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIGBUS
ee25ad77 FR	309	SIGPOLL SIGPROF SIGSYS SIGTRAP SIGURG SIGVTALRM SIGXCPU SIGXFSZ
3609ea0d JH	310	SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
3609ea0d JH	311	raise sigaction signal sigpending sigprocmask sigsuspend)],
66fbe9e2	312
d4742b2c	313	stdarg_h => [],
66fbe9e2 GS	314
	315	stddef_h => [qw(NULL offsetof)],
	316
	317	stdio_h => [qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid
	318	L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET
	319	STREAM_MAX TMP_MAX stderr stdin stdout
	320	clearerr fclose fdopen feof ferror fflush fgetc fgetpos
	321	fgets fopen fprintf fputc fputs fread freopen
	322	fscanf fseek fsetpos ftell fwrite getchar gets
	323	perror putc putchar puts remove rewind
	324	scanf setbuf setvbuf sscanf tmpfile tmpnam
	325	ungetc vfprintf vprintf vsprintf)],
	326
	327	stdlib_h => [qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX
	328	abort atexit atof atoi atol bsearch calloc div
	329	free getenv labs ldiv malloc mblen mbstowcs mbtowc
	330	qsort realloc strtod strtol strtoul wcstombs wctomb)],
	331
	332	string_h => [qw(NULL memchr memcmp memcpy memmove memset strcat
	333	strchr strcmp strcoll strcpy strcspn strerror strlen
	334	strncat strncmp strncpy strpbrk strrchr strspn strstr
	335	strtok strxfrm)],
	336
	337	sys_stat_h => [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
	338	S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG
	339	S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
	340	fstat mkfifo)],
	341
d4742b2c	342	sys_times_h => [],
66fbe9e2	343
d4742b2c	344	sys_types_h => [],
66fbe9e2 GS	345
	346	sys_utsname_h => [qw(uname)],
	347
	348	sys_wait_h => [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
	349	WNOHANG WSTOPSIG WTERMSIG WUNTRACED)],
	350
	351	termios_h => [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400
	352	B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL
	353	CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK
	354	ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR
	355	INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST
	356	PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION
	357	TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
	358	TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART
	359	VSTOP VSUSP VTIME
	360	cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain
	361	tcflow tcflush tcgetattr tcsendbreak tcsetattr )],
	362
	363	time_h => [qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
	364	difftime mktime strftime tzset tzname)],
	365
	366	unistd_h => [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
b250498f	367	STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
66fbe9e2 GS	368	_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON
	369	_PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX
	370	_PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED
	371	_POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS
	372	_POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX
	373	_SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
d61b6859	374	_SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS
66fbe9e2 GS	375	_SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
	376	_exit access ctermid cuserid
	377	dup2 dup execl execle execlp execv execve execvp
f0709b24	378	fpathconf fsync getcwd getegid geteuid getgid getgroups
66fbe9e2 GS	379	getpid getuid isatty lseek pathconf pause setgid setpgid
	380	setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
	381
d4742b2c	382	utime_h => [],
66fbe9e2 GS	383	);
	384
	385	# Exporter::export_tags();
85a5de57 NC	386	{
85a5de57 NC	387	# De-duplicate the export list:
a146a244 NC	388	my %export;
	389	@export{map {@$_} values %EXPORT_TAGS} = ();
	390	# Doing the de-dup with a temporary hash has the advantage that the SVs in
b7b1e41b	391	# @EXPORT are actually shared hash key scalars, which will save some memory.
b0ac411b	392	our @EXPORT = keys %export;
66fbe9e2	393
8dad66f8 NC	394	our @EXPORT_OK = (qw(close lchown nice open pipe read times write
	395	printf sprintf),
	396	grep {!exists $export{$_}} keys %reimpl, keys %replacement);
	397	}
66fbe9e2 GS	398
	399	require Exporter;
	400	}
557c0de7 BD	401
	402	package POSIX::SigAction;
	403
fc8b6fe2	404	sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] \|\| 0, SAFE => 0}, $_[0] }
557c0de7 BD	405	sub handler { $_[0]->{HANDLER} = $_[1] if @_ > 1; $_[0]->{HANDLER} };
	406	sub mask { $_[0]->{MASK} = $_[1] if @_ > 1; $_[0]->{MASK} };
	407	sub flags { $_[0]->{FLAGS} = $_[1] if @_ > 1; $_[0]->{FLAGS} };
d36b6582	408	sub safe { $_[0]->{SAFE} = $_[1] if @_ > 1; $_[0]->{SAFE} };
3609ea0d	409
983cc415 NC	410	package POSIX::SigRt;
983cc415 NC	411
122efcc9 AP	412	require Tie::Hash;
	413
	414	our @ISA = 'Tie::StdHash';
	415
	416	our ($_SIGRTMIN, $_SIGRTMAX, $_sigrtn);
	417
	418	our $SIGACTION_FLAGS = 0;
	419
983cc415 NC	420	sub _init {
	421	$_SIGRTMIN = &POSIX::SIGRTMIN;
	422	$_SIGRTMAX = &POSIX::SIGRTMAX;
	423	$_sigrtn = $_SIGRTMAX - $_SIGRTMIN;
	424	}
	425
	426	sub _croak {
	427	&_init unless defined $_sigrtn;
	428	die "POSIX::SigRt not available" unless defined $_sigrtn && $_sigrtn > 0;
	429	}
	430
	431	sub _getsig {
	432	&_croak;
	433	my $rtsig = $_[0];
	434	# Allow (SIGRT)?MIN( + n)?, a common idiom when doing these things in C.
	435	$rtsig = $_SIGRTMIN + ($1 \|\| 0)
	436	if $rtsig =~ /^(?:(?:SIG)?RT)?MIN(\s\+\s(\d+))?$/;
	437	return $rtsig;
	438	}
	439
	440	sub _exist {
	441	my $rtsig = _getsig($_[1]);
	442	my $ok = $rtsig >= $_SIGRTMIN && $rtsig <= $_SIGRTMAX;
	443	($rtsig, $ok);
	444	}
	445
	446	sub _check {
	447	my ($rtsig, $ok) = &_exist;
	448	die "No POSIX::SigRt signal $_[1] (valid range SIGRTMIN..SIGRTMAX, or $_SIGRTMIN..$_SIGRTMAX)"
	449	unless $ok;
	450	return $rtsig;
	451	}
	452
	453	sub new {
	454	my ($rtsig, $handler, $flags) = @_;
	455	my $sigset = POSIX::SigSet->new($rtsig);
b0ac411b	456	my $sigact = POSIX::SigAction->new($handler, $sigset, $flags);
983cc415 NC	457	POSIX::sigaction($rtsig, $sigact);
	458	}
	459
	460	sub EXISTS { &_exist }
	461	sub FETCH { my $rtsig = &_check;
	462	my $oa = POSIX::SigAction->new();
	463	POSIX::sigaction($rtsig, undef, $oa);
	464	return $oa->{HANDLER} }
	465	sub STORE { my $rtsig = &_check; new($rtsig, $_[2], $SIGACTION_FLAGS) }
	466	sub DELETE { delete $SIG{ &_check } }
	467	sub CLEAR { &_exist; delete @SIG{ &POSIX::SIGRTMIN .. &POSIX::SIGRTMAX } }
	468	sub SCALAR { &_croak; $_sigrtn + 1 }
122efcc9 AP	469
	470	tie %POSIX::SIGRT, 'POSIX::SigRt';
	471	# and the expression on the line above is true, so we return true.