xref: /openbsd/gnu/usr.bin/perl/ext/POSIX/lib/POSIX.pm (revision 4cfece93)
1package POSIX;
2use strict;
3use warnings;
4
5our ($AUTOLOAD, %SIGRT);
6
7our $VERSION = '1.88';
8
9require XSLoader;
10
11use 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
14	     O_WRONLY SEEK_CUR SEEK_END SEEK_SET
15	     S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG
16	     S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
17	     S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR);
18
19my $loaded;
20
21sub croak { require Carp;  goto &Carp::croak }
22sub usage { croak "Usage: POSIX::$_[0]" }
23
24XSLoader::load();
25
26my %replacement = (
27    L_tmpnam    => undef,
28    atexit      => 'END {}',
29    atof        => undef,
30    atoi        => undef,
31    atol        => undef,
32    bsearch     => \'not supplied',
33    calloc      => undef,
34    clearerr    => 'IO::Handle::clearerr',
35    div         => '/, % and int',
36    execl       => undef,
37    execle      => undef,
38    execlp      => undef,
39    execv       => undef,
40    execve      => undef,
41    execvp      => undef,
42    fclose      => 'IO::Handle::close',
43    fdopen      => 'IO::Handle::new_from_fd',
44    feof        => 'IO::Handle::eof',
45    ferror      => 'IO::Handle::error',
46    fflush      => 'IO::Handle::flush',
47    fgetc       => 'IO::Handle::getc',
48    fgetpos     => 'IO::Seekable::getpos',
49    fgets       => 'IO::Handle::gets',
50    fileno      => 'IO::Handle::fileno',
51    fopen       => 'IO::File::open',
52    fprintf     => 'printf',
53    fputc       => 'print',
54    fputs       => 'print',
55    fread       => 'read',
56    free        => undef,
57    freopen     => 'open',
58    fscanf      => '<> and regular expressions',
59    fseek       => 'IO::Seekable::seek',
60    fsetpos     => 'IO::Seekable::setpos',
61    fsync       => 'IO::Handle::sync',
62    ftell       => 'IO::Seekable::tell',
63    fwrite      => 'print',
64    labs        => 'abs',
65    ldiv        => '/, % and int',
66    longjmp     => 'die',
67    malloc      => undef,
68    memchr      => 'index()',
69    memcmp      => 'eq',
70    memcpy      => '=',
71    memmove     => '=',
72    memset      => 'x',
73    offsetof    => undef,
74    putc        => 'print',
75    putchar     => 'print',
76    puts        => 'print',
77    qsort       => 'sort',
78    rand        => \'non-portable, use Perl\'s rand instead',
79    realloc     => undef,
80    scanf       => '<> and regular expressions',
81    setbuf      => 'IO::Handle::setbuf',
82    setjmp      => 'eval {}',
83    setvbuf     => 'IO::Handle::setvbuf',
84    siglongjmp  => 'die',
85    sigsetjmp   => 'eval {}',
86    srand       => \'not supplied; refer to Perl\'s srand documentation',
87    sscanf      => 'regular expressions',
88    strcat      => '.=',
89    strchr      => 'index()',
90    strcmp      => 'eq',
91    strcpy      => '=',
92    strcspn     => 'regular expressions',
93    strlen      => 'length',
94    strncat     => '.=',
95    strncmp     => 'eq',
96    strncpy     => '=',
97    strpbrk     => undef,
98    strrchr     => 'rindex()',
99    strspn      => undef,
100    strtok      => undef,
101    tmpfile     => 'IO::File::new_tmpfile',
102    tmpnam      => 'use File::Temp',
103    ungetc      => 'IO::Handle::ungetc',
104    vfprintf    => undef,
105    vprintf     => undef,
106    vsprintf    => undef,
107);
108
109my %reimpl = (
110    abs       => 'x => CORE::abs($_[0])',
111    alarm     => 'seconds => CORE::alarm($_[0])',
112    assert    => 'expr => croak "Assertion failed" if !$_[0]',
113    atan2     => 'x, y => CORE::atan2($_[0], $_[1])',
114    chdir     => 'directory => CORE::chdir($_[0])',
115    chmod     => 'mode, filename => CORE::chmod($_[0], $_[1])',
116    chown     => 'uid, gid, filename => CORE::chown($_[0], $_[1], $_[2])',
117    closedir  => 'dirhandle => CORE::closedir($_[0])',
118    cos       => 'x => CORE::cos($_[0])',
119    creat     => 'filename, mode => &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1])',
120    errno     => '$! + 0',
121    exit      => 'status => CORE::exit($_[0])',
122    exp       => 'x => CORE::exp($_[0])',
123    fabs      => 'x => CORE::abs($_[0])',
124    fcntl     => 'filehandle, cmd, arg => CORE::fcntl($_[0], $_[1], $_[2])',
125    fork      => 'CORE::fork',
126    fstat     => 'fd => CORE::open my $dup, "<&", $_[0]; CORE::stat($dup)', # Gross.
127    getc      => 'handle => CORE::getc($_[0])',
128    getchar   => 'CORE::getc(STDIN)',
129    getegid   => '$) + 0',
130    getenv    => 'name => $ENV{$_[0]}',
131    geteuid   => '$> + 0',
132    getgid    => '$( + 0',
133    getgrgid  => 'gid => CORE::getgrgid($_[0])',
134    getgrnam  => 'name => CORE::getgrnam($_[0])',
135    getgroups => 'my %seen; grep !$seen{$_}++, split " ", $)',
136    getlogin  => 'CORE::getlogin()',
137    getpgrp   => 'CORE::getpgrp',
138    getpid    => '$$',
139    getppid   => 'CORE::getppid',
140    getpwnam  => 'name => CORE::getpwnam($_[0])',
141    getpwuid  => 'uid => CORE::getpwuid($_[0])',
142    gets      => 'scalar <STDIN>',
143    getuid    => '$<',
144    gmtime    => 'time => CORE::gmtime($_[0])',
145    isatty    => 'filehandle => -t $_[0]',
146    kill      => 'pid, sig => CORE::kill $_[1], $_[0]',
147    link      => 'oldfilename, newfilename => CORE::link($_[0], $_[1])',
148    localtime => 'time => CORE::localtime($_[0])',
149    log       => 'x => CORE::log($_[0])',
150    mkdir     => 'directoryname, mode => CORE::mkdir($_[0], $_[1])',
151    opendir   => 'directory => my $dh; CORE::opendir($dh, $_[0]) ? $dh : undef',
152    pow       => 'x, exponent => $_[0] ** $_[1]',
153    raise     => 'sig => CORE::kill $_[0], $$;	# Is this good enough',
154    readdir   => 'dirhandle => CORE::readdir($_[0])',
155    remove    => 'filename => (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0])',
156    rename    => 'oldfilename, newfilename => CORE::rename($_[0], $_[1])',
157    rewind    => 'filehandle => CORE::seek($_[0],0,0)',
158    rewinddir => 'dirhandle => CORE::rewinddir($_[0])',
159    rmdir     => 'directoryname => CORE::rmdir($_[0])',
160    sin       => 'x => CORE::sin($_[0])',
161    sqrt      => 'x => CORE::sqrt($_[0])',
162    stat      => 'filename => CORE::stat($_[0])',
163    strerror  => 'errno => BEGIN { local $!; require locale; locale->import} my $e = $_[0] + 0; local $!; $! = $e; "$!"',
164    strstr    => 'big, little => CORE::index($_[0], $_[1])',
165    system    => 'command => CORE::system($_[0])',
166    time      => 'CORE::time',
167    umask     => 'mask => CORE::umask($_[0])',
168    unlink    => 'filename => CORE::unlink($_[0])',
169    utime     => 'filename, atime, mtime => CORE::utime($_[1], $_[2], $_[0])',
170    wait      => 'CORE::wait()',
171    waitpid   => 'pid, options => CORE::waitpid($_[0], $_[1])',
172);
173
174sub import {
175    my $pkg = shift;
176
177    load_imports() unless $loaded++;
178
179    # Grandfather old foo_h form to new :foo_h form
180    s/^(?=\w+_h$)/:/ for my @list = @_;
181
182    my @unimpl = sort grep { exists $replacement{$_} } @list;
183    if (@unimpl) {
184      for my $u (@unimpl) {
185        warn "Unimplemented: POSIX::$u(): ", unimplemented_message($u);
186      }
187      croak(sprintf("Unimplemented: %s",
188                    join(" ", map { "POSIX::$_()" } @unimpl)));
189    }
190
191    local $Exporter::ExportLevel = 1;
192    Exporter::import($pkg,@list);
193}
194
195eval join ';', map "sub $_", keys %replacement, keys %reimpl;
196
197sub unimplemented_message {
198  my $func = shift;
199  my $how = $replacement{$func};
200  return "C-specific, stopped" unless defined $how;
201  return "$$how" if ref $how;
202  return "$how instead" if $how =~ /^use /;
203  return "Use method $how() instead" if $how =~ /::/;
204  return "C-specific: use $how instead";
205}
206
207sub AUTOLOAD {
208    my ($func) = ($AUTOLOAD =~ /.*::(.*)/);
209
210    die "POSIX.xs has failed to load\n" if $func eq 'constant';
211
212    if (my $code = $reimpl{$func}) {
213	my ($num, $arg) = (0, '');
214	if ($code =~ s/^(.*?) *=> *//) {
215	    $arg = $1;
216	    $num = 1 + $arg =~ tr/,//;
217	}
218	# no warnings to be consistent with the old implementation, where each
219	# function was in its own little AutoSplit world:
220	eval qq{ sub $func {
221		no warnings;
222		usage "$func($arg)" if \@_ != $num;
223		$code
224	    } };
225	no strict;
226	goto &$AUTOLOAD;
227    }
228    if (exists $replacement{$func}) {
229      croak "Unimplemented: POSIX::$func(): ", unimplemented_message($func);
230    }
231
232    constant($func);
233}
234
235sub perror {
236    print STDERR "@_: " if @_;
237    print STDERR $!,"\n";
238}
239
240sub printf {
241    usage "printf(pattern, args...)" if @_ < 1;
242    CORE::printf STDOUT @_;
243}
244
245sub sprintf {
246    usage "sprintf(pattern, args...)" if @_ == 0;
247    CORE::sprintf(shift,@_);
248}
249
250sub load_imports {
251my %default_export_tags = ( # cf. exports policy below
252
253    assert_h =>	[qw(assert NDEBUG)],
254
255    ctype_h =>	        [],
256
257    dirent_h =>	[],
258
259    errno_h =>	[qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT EAGAIN
260		EALREADY EBADF EBADMSG EBUSY ECANCELED ECHILD ECONNABORTED
261		ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT EEXIST
262		EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EIDRM EILSEQ EINPROGRESS
263		EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE
264		ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS
265		ENODATA ENODEV ENOENT ENOEXEC ENOLCK ENOLINK ENOMEM ENOMSG
266		ENOPROTOOPT ENOSPC ENOSR ENOSTR ENOSYS ENOTBLK ENOTCONN ENOTDIR
267		ENOTEMPTY ENOTRECOVERABLE ENOTSOCK ENOTSUP ENOTTY ENXIO
268		EOPNOTSUPP EOTHER EOVERFLOW EOWNERDEAD EPERM EPFNOSUPPORT EPIPE
269		EPROCLIM EPROTO EPROTONOSUPPORT EPROTOTYPE ERANGE EREMOTE
270		ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESTALE
271		ETIME ETIMEDOUT ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK EXDEV
272		errno)],
273
274    fcntl_h =>	[qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK
275		F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK
276		O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK
277		O_RDONLY O_RDWR O_TRUNC O_WRONLY
278		creat
279		SEEK_CUR SEEK_END SEEK_SET
280		S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
281		S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID
282		S_IWGRP S_IWOTH S_IWUSR)],
283
284    float_h =>	[qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG
285		DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP
286		DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
287		FLT_DIG FLT_EPSILON FLT_MANT_DIG
288		FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP
289		FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP
290		FLT_RADIX FLT_ROUNDS
291		LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG
292		LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP
293		LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)],
294
295    grp_h =>	[],
296
297    limits_h =>	[qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX
298		INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON
299		MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX
300		PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN
301		SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX
302		ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX
303		_POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT
304		_POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX
305		_POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
306		_POSIX_STREAM_MAX _POSIX_TZNAME_MAX)],
307
308    locale_h =>	[qw(LC_ALL LC_COLLATE LC_CTYPE LC_MESSAGES
309		    LC_MONETARY LC_NUMERIC LC_TIME LC_IDENTIFICATION
310                    LC_MEASUREMENT LC_PAPER LC_TELEPHONE LC_ADDRESS NULL
311		    localeconv setlocale)],
312
313    math_h =>   [qw(FP_ILOGB0 FP_ILOGBNAN FP_INFINITE FP_NAN FP_NORMAL
314                    FP_SUBNORMAL FP_ZERO
315                    M_1_PI M_2_PI M_2_SQRTPI M_E M_LN10 M_LN2 M_LOG10E M_LOG2E
316                    M_PI M_PI_2 M_PI_4 M_SQRT1_2 M_SQRT2
317                    HUGE_VAL INFINITY NAN
318                    acos asin atan ceil cosh fabs floor fmod
319		    frexp ldexp log10 modf pow sinh tan tanh)],
320
321    pwd_h =>	[],
322
323    setjmp_h =>	[qw(longjmp setjmp siglongjmp sigsetjmp)],
324
325    signal_h =>	[qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
326		SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
327		SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
328		SIGPIPE %SIGRT SIGRTMIN SIGRTMAX SIGQUIT SIGSEGV SIGSTOP
329		SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIGBUS
330		SIGPOLL SIGPROF SIGSYS SIGTRAP SIGURG SIGVTALRM SIGXCPU SIGXFSZ
331		SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
332		raise sigaction signal sigpending sigprocmask sigsuspend)],
333
334    stdarg_h =>	[],
335
336    stddef_h =>	[qw(NULL offsetof)],
337
338    stdio_h =>	[qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid
339		NULL SEEK_CUR SEEK_END SEEK_SET
340		STREAM_MAX TMP_MAX stderr stdin stdout
341		clearerr fclose fdopen feof ferror fflush fgetc fgetpos
342		fgets fopen fprintf fputc fputs fread freopen
343		fscanf fseek fsetpos ftell fwrite getchar gets
344		perror putc putchar puts remove rewind
345		scanf setbuf setvbuf sscanf tmpfile tmpnam
346		ungetc vfprintf vprintf vsprintf)],
347
348    stdlib_h =>	[qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX
349		abort atexit atof atoi atol bsearch calloc div
350		free getenv labs ldiv malloc mblen mbstowcs mbtowc
351		qsort realloc strtod strtol strtoul wcstombs wctomb)],
352
353    string_h =>	[qw(NULL memchr memcmp memcpy memmove memset strcat
354		strchr strcmp strcoll strcpy strcspn strerror strlen
355		strncat strncmp strncpy strpbrk strrchr strspn strstr
356		strtok strxfrm)],
357
358    sys_stat_h => [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
359		S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG
360		S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
361		fstat mkfifo)],
362
363    sys_times_h => [],
364
365    sys_types_h => [],
366
367    sys_utsname_h => [qw(uname)],
368
369    sys_wait_h => [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
370		WNOHANG WSTOPSIG WTERMSIG WUNTRACED)],
371
372    termios_h => [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400
373		B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL
374		CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK
375		ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR
376		INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST
377		PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION
378		TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
379		TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART
380		VSTOP VSUSP VTIME
381		cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain
382		tcflow tcflush tcgetattr tcsendbreak tcsetattr )],
383
384    time_h =>	[qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
385		difftime mktime strftime tzset tzname)],
386
387    unistd_h =>	[qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
388		STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
389		_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON
390		_PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX
391		_PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED
392		_POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS
393		_POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX
394		_SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
395		_SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS
396		_SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
397		_exit access ctermid cuserid
398		dup2 dup execl execle execlp execv execve execvp
399		fpathconf fsync getcwd getegid geteuid getgid getgroups
400		getpid getuid isatty lseek pathconf pause setgid setpgid
401		setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
402
403    utime_h =>	[],
404);
405
406if ($^O eq 'MSWin32') {
407    $default_export_tags{winsock_h} = [qw(
408	WSAEINTR WSAEBADF WSAEACCES WSAEFAULT WSAEINVAL WSAEMFILE WSAEWOULDBLOCK
409	WSAEINPROGRESS WSAEALREADY WSAENOTSOCK WSAEDESTADDRREQ WSAEMSGSIZE
410	WSAEPROTOTYPE WSAENOPROTOOPT WSAEPROTONOSUPPORT WSAESOCKTNOSUPPORT
411	WSAEOPNOTSUPP WSAEPFNOSUPPORT WSAEAFNOSUPPORT WSAEADDRINUSE
412	WSAEADDRNOTAVAIL WSAENETDOWN WSAENETUNREACH WSAENETRESET WSAECONNABORTED
413	WSAECONNRESET WSAENOBUFS WSAEISCONN WSAENOTCONN WSAESHUTDOWN
414	WSAETOOMANYREFS WSAETIMEDOUT WSAECONNREFUSED WSAELOOP WSAENAMETOOLONG
415	WSAEHOSTDOWN WSAEHOSTUNREACH WSAENOTEMPTY WSAEPROCLIM WSAEUSERS
416	WSAEDQUOT WSAESTALE WSAEREMOTE WSAEDISCON WSAENOMORE WSAECANCELLED
417	WSAEINVALIDPROCTABLE WSAEINVALIDPROVIDER WSAEPROVIDERFAILEDINIT
418	WSAEREFUSED)];
419}
420
421my %other_export_tags = ( # cf. exports policy below
422    fenv_h => [qw(
423        FE_DOWNWARD FE_TONEAREST FE_TOWARDZERO FE_UPWARD fegetround fesetround
424    )],
425
426    math_h_c99 => [ @{$default_export_tags{math_h}}, qw(
427        Inf NaN acosh asinh atanh cbrt copysign erf erfc exp2 expm1 fdim fma
428        fmax fmin fpclassify hypot ilogb isfinite isgreater isgreaterequal
429        isinf isless islessequal islessgreater isnan isnormal isunordered j0 j1
430        jn lgamma log1p log2 logb lrint lround nan nearbyint nextafter nexttoward
431        remainder remquo rint round scalbn signbit tgamma trunc y0 y1 yn
432    )],
433
434    netdb_h => [qw(EAI_AGAIN    EAI_BADFLAGS EAI_FAIL
435                   EAI_FAMILY   EAI_MEMORY   EAI_NONAME
436                   EAI_OVERFLOW EAI_SERVICE  EAI_SOCKTYPE
437                   EAI_SYSTEM)],
438
439    stdlib_h_c99 => [ @{$default_export_tags{stdlib_h}}, 'strtold' ],
440
441    sys_resource_h => [qw(PRIO_PROCESS PRIO_PGRP PRIO_USER)],
442
443    sys_socket_h => [qw(
444        MSG_CTRUNC MSG_DONTROUTE MSG_EOR MSG_OOB MSG_PEEK MSG_TRUNC MSG_WAITALL
445    )],
446
447    nan_payload => [ qw(getpayload setpayload setpayloadsig issignaling) ],
448
449    signal_h_si_code => [qw(
450        ILL_ILLOPC ILL_ILLOPN ILL_ILLADR ILL_ILLTRP ILL_PRVOPC ILL_PRVREG
451        ILL_COPROC ILL_BADSTK
452        FPE_INTDIV FPE_INTOVF FPE_FLTDIV FPE_FLTOVF FPE_FLTUND
453        FPE_FLTRES FPE_FLTINV FPE_FLTSUB
454        SEGV_MAPERR SEGV_ACCERR
455        BUS_ADRALN BUS_ADRERR BUS_OBJERR
456        TRAP_BRKPT TRAP_TRACE
457        CLD_EXITED CLD_KILLED CLD_DUMPED CLD_TRAPPED CLD_STOPPED CLD_CONTINUED
458        POLL_IN POLL_OUT POLL_MSG POLL_ERR POLL_PRI POLL_HUP
459        SI_USER SI_QUEUE SI_TIMER SI_ASYNCIO SI_MESGQ
460  )],
461);
462
463# exports policy:
464# - new functions may not be added to @EXPORT, only to @EXPORT_OK
465# - new SHOUTYCONSTANTS are OK to add to @EXPORT
466
467{
468  # De-duplicate the export list:
469  my ( %export, %export_ok );
470  @export   {map {@$_} values %default_export_tags} = ();
471  @export_ok{map {@$_} values   %other_export_tags} = ();
472  # Doing the de-dup with a temporary hash has the advantage that the SVs in
473  # @EXPORT are actually shared hash key scalars, which will save some memory.
474  our @EXPORT = keys %export;
475
476  # you do not want to add symbols to the following list. add a new tag instead
477  our @EXPORT_OK = (qw(close lchown nice open pipe read sleep times write
478		       printf sprintf),
479		    grep {!exists $export{$_}} keys %reimpl, keys %replacement, keys %export_ok);
480
481  our %EXPORT_TAGS = ( %default_export_tags, %other_export_tags );
482}
483
484require Exporter;
485}
486
487package POSIX::SigAction;
488
489sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0, SAFE => 0}, $_[0] }
490sub handler { $_[0]->{HANDLER} = $_[1] if @_ > 1; $_[0]->{HANDLER} };
491sub mask    { $_[0]->{MASK}    = $_[1] if @_ > 1; $_[0]->{MASK} };
492sub flags   { $_[0]->{FLAGS}   = $_[1] if @_ > 1; $_[0]->{FLAGS} };
493sub safe    { $_[0]->{SAFE}    = $_[1] if @_ > 1; $_[0]->{SAFE} };
494
495{
496package POSIX::SigSet;
497# This package is here entirely to make sure that POSIX::SigSet is seen by the
498# PAUSE indexer, so that it will always be clearly indexed in core.  This is to
499# prevent the accidental case where a third-party distribution can accidentally
500# claim the POSIX::SigSet package, as occurred in 2011-12. -- rjbs, 2011-12-30
501}
502
503package POSIX::SigRt;
504
505require Tie::Hash;
506
507our @ISA = 'Tie::StdHash';
508
509our ($_SIGRTMIN, $_SIGRTMAX, $_sigrtn);
510
511our $SIGACTION_FLAGS = 0;
512
513sub _init {
514    $_SIGRTMIN = &POSIX::SIGRTMIN;
515    $_SIGRTMAX = &POSIX::SIGRTMAX;
516    $_sigrtn   = $_SIGRTMAX - $_SIGRTMIN;
517}
518
519sub _croak {
520    &_init unless defined $_sigrtn;
521    die "POSIX::SigRt not available" unless defined $_sigrtn && $_sigrtn > 0;
522}
523
524sub _getsig {
525    &_croak;
526    my $rtsig = $_[0];
527    # Allow (SIGRT)?MIN( + n)?, a common idiom when doing these things in C.
528    $rtsig = $_SIGRTMIN + ($1 || 0)
529	if $rtsig =~ /^(?:(?:SIG)?RT)?MIN(\s*\+\s*(\d+))?$/;
530    return $rtsig;
531}
532
533sub _exist {
534    my $rtsig = _getsig($_[1]);
535    my $ok    = $rtsig >= $_SIGRTMIN && $rtsig <= $_SIGRTMAX;
536    ($rtsig, $ok);
537}
538
539sub _check {
540    my ($rtsig, $ok) = &_exist;
541    die "No POSIX::SigRt signal $_[1] (valid range SIGRTMIN..SIGRTMAX, or $_SIGRTMIN..$_SIGRTMAX)"
542	unless $ok;
543    return $rtsig;
544}
545
546sub new {
547    my ($rtsig, $handler, $flags) = @_;
548    my $sigset = POSIX::SigSet->new($rtsig);
549    my $sigact = POSIX::SigAction->new($handler, $sigset, $flags);
550    POSIX::sigaction($rtsig, $sigact);
551}
552
553sub EXISTS { &_exist }
554sub FETCH  { my $rtsig = &_check;
555	     my $oa = POSIX::SigAction->new();
556	     POSIX::sigaction($rtsig, undef, $oa);
557	     return $oa->{HANDLER} }
558sub STORE  { my $rtsig = &_check; new($rtsig, $_[2], $SIGACTION_FLAGS) }
559sub DELETE { delete $SIG{ &_check } }
560sub CLEAR  { &_exist; delete @SIG{ &POSIX::SIGRTMIN .. &POSIX::SIGRTMAX } }
561sub SCALAR { &_croak; $_sigrtn + 1 }
562
563tie %POSIX::SIGRT, 'POSIX::SigRt';
564# and the expression on the line above is true, so we return true.
565