This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
g++ cleanups.
[perl5.git] / ext / POSIX / POSIX.xs
CommitLineData
6e22d046
JH
1#define PERL_EXT_POSIX
2
2986a63f
JH
3#ifdef NETWARE
4 #define _POSIX_
4efcf9a2
SB
5 /*
6 * Ideally this should be somewhere down in the includes
7 * but putting it in other places is giving compiler errors.
8 * Also here I am unable to check for HAS_UNAME since it wouldn't have
9 * yet come into the file at this stage - sgp 18th Oct 2000
10 */
2986a63f
JH
11 #include <sys/utsname.h>
12#endif /* NETWARE */
13
c5be433b
GS
14#define PERL_NO_GET_CONTEXT
15
463ee0b2 16#include "EXTERN.h"
760ac839 17#define PERLIO_NOT_STDIO 1
463ee0b2
LW
18#include "perl.h"
19#include "XSUB.h"
acfe0abc 20#if defined(PERL_IMPLICIT_SYS)
873ef191
GS
21# undef signal
22# undef open
cd661bb6 23# undef setmode
35ff7856 24# define open PerlLIO_open3
873ef191 25#endif
2304df62 26#include <ctype.h>
a0d0e21e 27#ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */
2304df62 28#include <dirent.h>
a0d0e21e 29#endif
2304df62 30#include <errno.h>
b0ba2190
SH
31#ifdef WIN32
32#include <sys/errno2.h>
33#endif
2304df62
AD
34#ifdef I_FLOAT
35#include <float.h>
36#endif
a0d0e21e 37#ifdef I_LIMITS
2304df62 38#include <limits.h>
a0d0e21e 39#endif
2304df62
AD
40#include <locale.h>
41#include <math.h>
85e6fe83 42#ifdef I_PWD
2304df62 43#include <pwd.h>
85e6fe83 44#endif
2304df62
AD
45#include <setjmp.h>
46#include <signal.h>
2304df62 47#include <stdarg.h>
17c3b450 48
2304df62
AD
49#ifdef I_STDDEF
50#include <stddef.h>
51#endif
6990d991 52
b5846a0b
BS
53#ifdef I_UNISTD
54#include <unistd.h>
55#endif
56
3609ea0d 57/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
a0d0e21e
LW
58 metaconfig for future extension writers. We don't use them in POSIX.
59 (This is really sneaky :-) --AD
60*/
61#if defined(I_TERMIOS)
62#include <termios.h>
63#endif
a0d0e21e 64#ifdef I_STDLIB
2304df62 65#include <stdlib.h>
a0d0e21e 66#endif
5518ecd4 67#ifndef __ultrix__
2304df62 68#include <string.h>
5518ecd4 69#endif
2304df62 70#include <sys/stat.h>
2304df62 71#include <sys/types.h>
2304df62 72#include <time.h>
6dead956 73#ifdef I_UNISTD
1d2dff63 74#include <unistd.h>
6dead956 75#endif
71be2cbc
PP
76#include <fcntl.h>
77
e2465f50 78#ifdef HAS_TZNAME
fb207d52 79# if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
e2465f50
JH
80extern char *tzname[];
81# endif
82#else
fb207d52 83#if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
e2465f50
JH
84char *tzname[] = { "" , "" };
85#endif
cb2479a8
JH
86#endif
87
6c418a22 88#if defined(__VMS) && !defined(__POSIX_SOURCE)
294c8bc4
CB
89
90# include <utsname.h>
6c418a22 91
6990d991 92# undef mkfifo
6c418a22 93# define mkfifo(a,b) (not_here("mkfifo"),-1)
6c418a22
PP
94
95 /* The POSIX notion of ttyname() is better served by getname() under VMS */
96 static char ttnambuf[64];
97# define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
98
6c418a22 99#else
d308986b 100#if defined (__CYGWIN__)
f89d6eaa
FE
101# define tzname _tzname
102#endif
2986a63f 103#if defined (WIN32) || defined (NETWARE)
6990d991 104# undef mkfifo
6dead956 105# define mkfifo(a,b) not_here("mkfifo")
873ef191 106# define ttyname(a) (char*)not_here("ttyname")
6dead956 107# define sigset_t long
86200d5c 108# define pid_t long
6dead956
GS
109# ifdef _MSC_VER
110# define mode_t short
111# endif
62520c91
GS
112# ifdef __MINGW32__
113# define mode_t short
f6c6487a
GS
114# ifndef tzset
115# define tzset() not_here("tzset")
116# endif
117# ifndef _POSIX_OPEN_MAX
118# define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
119# endif
62520c91 120# endif
6dead956
GS
121# define sigaction(a,b,c) not_here("sigaction")
122# define sigpending(a) not_here("sigpending")
123# define sigprocmask(a,b,c) not_here("sigprocmask")
124# define sigsuspend(a) not_here("sigsuspend")
125# define sigemptyset(a) not_here("sigemptyset")
126# define sigaddset(a,b) not_here("sigaddset")
127# define sigdelset(a,b) not_here("sigdelset")
128# define sigfillset(a) not_here("sigfillset")
129# define sigismember(a,b) not_here("sigismember")
2986a63f 130#ifndef NETWARE
6e22d046
JH
131# undef setuid
132# undef setgid
2986a63f
JH
133# define setuid(a) not_here("setuid")
134# define setgid(a) not_here("setgid")
135#endif /* NETWARE */
6dead956 136#else
6990d991
JH
137
138# ifndef HAS_MKFIFO
e37778c2 139# if defined(OS2)
d6a255e6 140# define mkfifo(a,b) not_here("mkfifo")
3609ea0d 141# else /* !( defined OS2 ) */
d6a255e6
IZ
142# ifndef mkfifo
143# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
144# endif
6990d991
JH
145# endif
146# endif /* !HAS_MKFIFO */
147
e37778c2
NC
148# ifdef I_GRP
149# include <grp.h>
150# endif
151# include <sys/times.h>
152# ifdef HAS_UNAME
153# include <sys/utsname.h>
6c418a22 154# endif
e37778c2 155# include <sys/wait.h>
6c418a22
PP
156# ifdef I_UTIME
157# include <utime.h>
158# endif
2986a63f 159#endif /* WIN32 || NETWARE */
6dead956 160#endif /* __VMS */
2304df62
AD
161
162typedef int SysRet;
a0d0e21e 163typedef long SysRetLong;
2304df62
AD
164typedef sigset_t* POSIX__SigSet;
165typedef HV* POSIX__SigAction;
a0d0e21e
LW
166#ifdef I_TERMIOS
167typedef struct termios* POSIX__Termios;
168#else /* Define termios types to int, and call not_here for the functions.*/
169#define POSIX__Termios int
170#define speed_t int
171#define tcflag_t int
172#define cc_t int
173#define cfgetispeed(x) not_here("cfgetispeed")
174#define cfgetospeed(x) not_here("cfgetospeed")
175#define tcdrain(x) not_here("tcdrain")
176#define tcflush(x,y) not_here("tcflush")
177#define tcsendbreak(x,y) not_here("tcsendbreak")
178#define cfsetispeed(x,y) not_here("cfsetispeed")
179#define cfsetospeed(x,y) not_here("cfsetospeed")
180#define ctermid(x) (char *) not_here("ctermid")
181#define tcflow(x,y) not_here("tcflow")
182#define tcgetattr(x,y) not_here("tcgetattr")
183#define tcsetattr(x,y,z) not_here("tcsetattr")
184#endif
185
186/* Possibly needed prototypes */
6e22d046 187#ifndef WIN32
a2e65780 188START_EXTERN_C
20ce7b12
GS
189double strtod (const char *, char **);
190long strtol (const char *, char **, int);
191unsigned long strtoul (const char *, char **, int);
a2e65780 192END_EXTERN_C
6e22d046 193#endif
a0d0e21e 194
a0d0e21e
LW
195#ifndef HAS_DIFFTIME
196#ifndef difftime
197#define difftime(a,b) not_here("difftime")
198#endif
199#endif
200#ifndef HAS_FPATHCONF
3609ea0d 201#define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
a0d0e21e
LW
202#endif
203#ifndef HAS_MKTIME
204#define mktime(a) not_here("mktime")
8990e307
LW
205#endif
206#ifndef HAS_NICE
207#define nice(a) not_here("nice")
208#endif
a0d0e21e 209#ifndef HAS_PATHCONF
3609ea0d 210#define pathconf(f,n) (SysRetLong) not_here("pathconf")
a0d0e21e
LW
211#endif
212#ifndef HAS_SYSCONF
3609ea0d 213#define sysconf(n) (SysRetLong) not_here("sysconf")
a0d0e21e 214#endif
8990e307
LW
215#ifndef HAS_READLINK
216#define readlink(a,b,c) not_here("readlink")
217#endif
218#ifndef HAS_SETPGID
219#define setpgid(a,b) not_here("setpgid")
220#endif
8990e307
LW
221#ifndef HAS_SETSID
222#define setsid() not_here("setsid")
223#endif
a0d0e21e
LW
224#ifndef HAS_STRCOLL
225#define strcoll(s1,s2) not_here("strcoll")
226#endif
a89d8a78
DH
227#ifndef HAS_STRTOD
228#define strtod(s1,s2) not_here("strtod")
229#endif
230#ifndef HAS_STRTOL
231#define strtol(s1,s2,b) not_here("strtol")
232#endif
233#ifndef HAS_STRTOUL
234#define strtoul(s1,s2,b) not_here("strtoul")
235#endif
a0d0e21e
LW
236#ifndef HAS_STRXFRM
237#define strxfrm(s1,s2,n) not_here("strxfrm")
8990e307
LW
238#endif
239#ifndef HAS_TCGETPGRP
240#define tcgetpgrp(a) not_here("tcgetpgrp")
241#endif
242#ifndef HAS_TCSETPGRP
243#define tcsetpgrp(a,b) not_here("tcsetpgrp")
244#endif
245#ifndef HAS_TIMES
2986a63f 246#ifndef NETWARE
8990e307 247#define times(a) not_here("times")
2986a63f 248#endif /* NETWARE */
8990e307
LW
249#endif
250#ifndef HAS_UNAME
251#define uname(a) not_here("uname")
252#endif
253#ifndef HAS_WAITPID
254#define waitpid(a,b,c) not_here("waitpid")
255#endif
256
a0d0e21e
LW
257#ifndef HAS_MBLEN
258#ifndef mblen
259#define mblen(a,b) not_here("mblen")
260#endif
261#endif
262#ifndef HAS_MBSTOWCS
263#define mbstowcs(s, pwcs, n) not_here("mbstowcs")
264#endif
265#ifndef HAS_MBTOWC
266#define mbtowc(pwc, s, n) not_here("mbtowc")
267#endif
268#ifndef HAS_WCSTOMBS
269#define wcstombs(s, pwcs, n) not_here("wcstombs")
270#endif
271#ifndef HAS_WCTOMB
272#define wctomb(s, wchar) not_here("wcstombs")
273#endif
274#if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
275/* If we don't have these functions, then we wouldn't have gotten a typedef
276 for wchar_t, the wide character type. Defining wchar_t allows the
277 functions referencing it to compile. Its actual type is then meaningless,
278 since without the above functions, all sections using it end up calling
279 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
280#ifndef wchar_t
281#define wchar_t char
282#endif
283#endif
284
2f0945cb
NC
285#ifdef HAS_LOCALECONV
286struct lconv_offset {
287 const char *name;
288 size_t offset;
289};
290
291const struct lconv_offset lconv_strings[] = {
292 {"decimal_point", offsetof(struct lconv, decimal_point)},
293 {"thousands_sep", offsetof(struct lconv, thousands_sep)},
294#ifndef NO_LOCALECONV_GROUPING
295 {"grouping", offsetof(struct lconv, grouping)},
296#endif
297 {"int_curr_symbol", offsetof(struct lconv, int_curr_symbol)},
298 {"currency_symbol", offsetof(struct lconv, currency_symbol)},
299 {"mon_decimal_point", offsetof(struct lconv, mon_decimal_point)},
300#ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
301 {"mon_thousands_sep", offsetof(struct lconv, mon_thousands_sep)},
302#endif
303#ifndef NO_LOCALECONV_MON_GROUPING
304 {"mon_grouping", offsetof(struct lconv, mon_grouping)},
305#endif
306 {"positive_sign", offsetof(struct lconv, positive_sign)},
307 {"negative_sign", offsetof(struct lconv, negative_sign)},
308 {NULL, 0}
309};
310
311const struct lconv_offset lconv_integers[] = {
312 {"int_frac_digits", offsetof(struct lconv, int_frac_digits)},
313 {"frac_digits", offsetof(struct lconv, frac_digits)},
314 {"p_cs_precedes", offsetof(struct lconv, p_cs_precedes)},
315 {"p_sep_by_space", offsetof(struct lconv, p_sep_by_space)},
316 {"n_cs_precedes", offsetof(struct lconv, n_cs_precedes)},
317 {"n_sep_by_space", offsetof(struct lconv, n_sep_by_space)},
318 {"p_sign_posn", offsetof(struct lconv, p_sign_posn)},
319 {"n_sign_posn", offsetof(struct lconv, n_sign_posn)},
320 {NULL, 0}
321};
322
323#else
a0d0e21e
LW
324#define localeconv() not_here("localeconv")
325#endif
326
172ea7c8 327#ifdef HAS_LONG_DOUBLE
53796371 328# if LONG_DOUBLESIZE > NVSIZE
172ea7c8
JH
329# undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
330# endif
331#endif
332
333#ifndef HAS_LONG_DOUBLE
334#ifdef LDBL_MAX
335#undef LDBL_MAX
336#endif
337#ifdef LDBL_MIN
338#undef LDBL_MIN
339#endif
340#ifdef LDBL_EPSILON
341#undef LDBL_EPSILON
342#endif
343#endif
344
ec193bec
JH
345/* Background: in most systems the low byte of the wait status
346 * is the signal (the lowest 7 bits) and the coredump flag is
347 * the eight bit, and the second lowest byte is the exit status.
348 * BeOS bucks the trend and has the bytes in different order.
349 * See beos/beos.c for how the reality is bent even in BeOS
350 * to follow the traditional. However, to make the POSIX
351 * wait W*() macros to work in BeOS, we need to unbend the
352 * reality back in place. --jhi */
17028706
IW
353/* In actual fact the code below is to blame here. Perl has an internal
354 * representation of the exit status ($?), which it re-composes from the
355 * OS's representation using the W*() POSIX macros. The code below
356 * incorrectly uses the W*() macros on the internal representation,
357 * which fails for OSs that have a different representation (namely BeOS
358 * and Haiku). WMUNGE() is a hack that converts the internal
359 * representation into the OS specific one, so that the W*() macros work
360 * as expected. The better solution would be not to use the W*() macros
361 * in the first place, though. -- Ingo Weinhold
362 */
b6c36746 363#if defined(__HAIKU__)
ec193bec
JH
364# define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
365#else
366# define WMUNGE(x) (x)
367#endif
368
8990e307 369static int
4b48cf39 370not_here(const char *s)
8990e307
LW
371{
372 croak("POSIX::%s not implemented on this architecture", s);
373 return -1;
374}
463ee0b2 375
1cb0fb50 376#include "const-c.inc"
a290f238 377
1dfe7606 378static void
40b7a5f5 379restore_sigmask(pTHX_ SV *osset_sv)
1dfe7606 380{
7feb700b
JH
381 /* Fortunately, restoring the signal mask can't fail, because
382 * there's nothing we can do about it if it does -- we're not
383 * supposed to return -1 from sigaction unless the disposition
384 * was unaffected.
385 */
7feb700b
JH
386 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
387 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
1dfe7606 388}
389
a2261f90
NC
390static void *
391allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) {
392 SV *const t = newSVrv(rv, packname);
393 void *const p = sv_grow(t, size + 1);
394
395 SvCUR_set(t, size);
396 SvPOK_on(t);
397 return p;
398}
399
81ab4c44
SH
400#ifdef WIN32
401
402/*
403 * (1) The CRT maintains its own copy of the environment, separate from
404 * the Win32API copy.
405 *
406 * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
407 * copy, and then calls SetEnvironmentVariableA() to update the Win32API
408 * copy.
409 *
410 * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
411 * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
412 * environment.
413 *
414 * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
415 * calls CRT tzset(), but only the first time it is called, and in turn
416 * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
417 * local copy of the environment and hence gets the original setting as
418 * perl never updates the CRT copy when assigning to $ENV{TZ}.
419 *
420 * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
421 * putenv() to update the CRT copy of the environment (if it is different)
422 * whenever we're about to call tzset().
423 *
424 * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
425 * defined:
426 *
427 * (a) Each interpreter has its own copy of the environment inside the
428 * perlhost structure. That allows applications that host multiple
429 * independent Perl interpreters to isolate environment changes from
430 * each other. (This is similar to how the perlhost mechanism keeps a
431 * separate working directory for each Perl interpreter, so that calling
432 * chdir() will not affect other interpreters.)
433 *
434 * (b) Only the first Perl interpreter instantiated within a process will
435 * "write through" environment changes to the process environment.
436 *
437 * (c) Even the primary Perl interpreter won't update the CRT copy of the
438 * the environment, only the Win32API copy (it calls win32_putenv()).
439 *
440 * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
441 * sense to only update the process environment when inside the main
442 * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
443 * from here so we'll just have to check PL_curinterp instead.
444 *
445 * Therefore, we can simply #undef getenv() and putenv() so that those names
446 * always refer to the CRT functions, and explicitly call win32_getenv() to
447 * access perl's %ENV.
448 *
449 * We also #undef malloc() and free() to be sure we are using the CRT
450 * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
451 * into VMem::Malloc() and VMem::Free() and all allocations will be freed
452 * when the Perl interpreter is being destroyed so we'd end up with a pointer
453 * into deallocated memory in environ[] if a program embedding a Perl
454 * interpreter continues to operate even after the main Perl interpreter has
455 * been destroyed.
456 *
457 * Note that we don't free() the malloc()ed memory unless and until we call
458 * malloc() again ourselves because the CRT putenv() function simply puts its
b7b1e41b 459 * pointer argument into the environ[] array (it doesn't make a copy of it)
81ab4c44
SH
460 * so this memory must otherwise be leaked.
461 */
462
463#undef getenv
464#undef putenv
465#undef malloc
466#undef free
467
468static void
469fix_win32_tzenv(void)
470{
471 static char* oldenv = NULL;
472 char* newenv;
473 const char* perl_tz_env = win32_getenv("TZ");
474 const char* crt_tz_env = getenv("TZ");
475 if (perl_tz_env == NULL)
476 perl_tz_env = "";
477 if (crt_tz_env == NULL)
478 crt_tz_env = "";
479 if (strcmp(perl_tz_env, crt_tz_env) != 0) {
480 newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
481 if (newenv != NULL) {
482 sprintf(newenv, "TZ=%s", perl_tz_env);
483 putenv(newenv);
484 if (oldenv != NULL)
485 free(oldenv);
486 oldenv = newenv;
487 }
488 }
489}
490
491#endif
492
493/*
494 * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
495 * This code is duplicated in the Time-Piece module, so any changes made here
496 * should be made there too.
497 */
498static void
499my_tzset(pTHX)
500{
501#ifdef WIN32
502#if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
503 if (PL_curinterp == aTHX)
504#endif
505 fix_win32_tzenv();
506#endif
507 tzset();
508}
509
fb52dbc1
NC
510typedef int (*isfunc_t)(int);
511typedef void (*any_dptr_t)(void *);
512
513/* This needs to be ALIASed in a custom way, hence can't easily be defined as
514 a regular XSUB. */
515static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */
516static XSPROTO(is_common)
517{
518 dXSARGS;
2da736a2
KW
519 static PTR_TBL_t * is_common_ptr_table;
520
fb52dbc1
NC
521 if (items != 1)
522 croak_xs_usage(cv, "charstring");
523
524 {
525 dXSTARG;
526 STRLEN len;
31e107a4
KW
527 /*int RETVAL = 0; YYY means uncomment this to return false on an
528 * empty string input */
fb52dbc1
NC
529 int RETVAL;
530 unsigned char *s = (unsigned char *) SvPV(ST(0), len);
531 unsigned char *e = s + len;
532 isfunc_t isfunc = (isfunc_t) XSANY.any_dptr;
533
2da736a2
KW
534 if (ckWARN_d(WARN_DEPRECATED)) {
535
536 /* Warn exactly once for each lexical place this function is
537 * called. See thread at
538 * http://markmail.org/thread/jhqcag5njmx7jpyu */
539
540 if (! is_common_ptr_table) {
541 is_common_ptr_table = ptr_table_new();
542 }
543 if (! ptr_table_fetch(is_common_ptr_table, PL_op)) {
544 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
545 "Calling POSIX::%"HEKf"() is deprecated",
546 HEKfARG(GvNAME_HEK(CvGV(cv))));
547 ptr_table_store(is_common_ptr_table, PL_op, (void *) 1);
548 }
549 }
550
31e107a4 551 /*if (e > s) { YYY */
fb52dbc1
NC
552 for (RETVAL = 1; RETVAL && s < e; s++)
553 if (!isfunc(*s))
554 RETVAL = 0;
31e107a4 555 /*} YYY */
fb52dbc1
NC
556 XSprePUSH;
557 PUSHi((IV)RETVAL);
558 }
559 XSRETURN(1);
560}
561
562MODULE = POSIX PACKAGE = POSIX
563
564BOOT:
565{
566 CV *cv;
567 const char *file = __FILE__;
568
df164f52
DM
569
570 /* silence compiler warning about not_here() defined but not used */
571 if (0) not_here("");
572
fb52dbc1
NC
573 /* Ensure we get the function, not a macro implementation. Like the C89
574 standard says we can... */
575#undef isalnum
576 cv = newXS("POSIX::isalnum", is_common, file);
577 XSANY.any_dptr = (any_dptr_t) &isalnum;
578#undef isalpha
579 cv = newXS("POSIX::isalpha", is_common, file);
580 XSANY.any_dptr = (any_dptr_t) &isalpha;
581#undef iscntrl
582 cv = newXS("POSIX::iscntrl", is_common, file);
583 XSANY.any_dptr = (any_dptr_t) &iscntrl;
584#undef isdigit
585 cv = newXS("POSIX::isdigit", is_common, file);
586 XSANY.any_dptr = (any_dptr_t) &isdigit;
587#undef isgraph
588 cv = newXS("POSIX::isgraph", is_common, file);
589 XSANY.any_dptr = (any_dptr_t) &isgraph;
590#undef islower
591 cv = newXS("POSIX::islower", is_common, file);
592 XSANY.any_dptr = (any_dptr_t) &islower;
593#undef isprint
594 cv = newXS("POSIX::isprint", is_common, file);
595 XSANY.any_dptr = (any_dptr_t) &isprint;
596#undef ispunct
597 cv = newXS("POSIX::ispunct", is_common, file);
598 XSANY.any_dptr = (any_dptr_t) &ispunct;
599#undef isspace
600 cv = newXS("POSIX::isspace", is_common, file);
601 XSANY.any_dptr = (any_dptr_t) &isspace;
602#undef isupper
603 cv = newXS("POSIX::isupper", is_common, file);
604 XSANY.any_dptr = (any_dptr_t) &isupper;
605#undef isxdigit
606 cv = newXS("POSIX::isxdigit", is_common, file);
607 XSANY.any_dptr = (any_dptr_t) &isxdigit;
608}
609
2304df62
AD
610MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
611
92b39396 612void
2304df62 613new(packname = "POSIX::SigSet", ...)
d3f5e399 614 const char * packname
2304df62
AD
615 CODE:
616 {
617 int i;
92b39396
NC
618 sigset_t *const s
619 = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
620 sizeof(sigset_t),
621 packname);
622 sigemptyset(s);
a0d0e21e 623 for (i = 1; i < items; i++)
92b39396
NC
624 sigaddset(s, SvIV(ST(i)));
625 XSRETURN(1);
2304df62 626 }
2304df62
AD
627
628SysRet
df6c2df2 629addset(sigset, sig)
2304df62
AD
630 POSIX::SigSet sigset
631 int sig
df6c2df2
NC
632 ALIAS:
633 delset = 1
634 CODE:
635 RETVAL = ix ? sigdelset(sigset, sig) : sigaddset(sigset, sig);
636 OUTPUT:
637 RETVAL
2304df62
AD
638
639SysRet
df6c2df2 640emptyset(sigset)
2304df62 641 POSIX::SigSet sigset
df6c2df2
NC
642 ALIAS:
643 fillset = 1
644 CODE:
645 RETVAL = ix ? sigfillset(sigset) : sigemptyset(sigset);
646 OUTPUT:
647 RETVAL
2304df62
AD
648
649int
650sigismember(sigset, sig)
651 POSIX::SigSet sigset
652 int sig
653
a0d0e21e
LW
654MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
655
11a39fe4 656void
a0d0e21e 657new(packname = "POSIX::Termios", ...)
d3f5e399 658 const char * packname
a0d0e21e
LW
659 CODE:
660 {
661#ifdef I_TERMIOS
a2261f90
NC
662 void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
663 sizeof(struct termios), packname);
11a39fe4
NC
664 /* The previous implementation stored a pointer to an uninitialised
665 struct termios. Seems safer to initialise it, particularly as
666 this implementation exposes the struct to prying from perl-space.
667 */
a2261f90 668 memset(p, 0, 1 + sizeof(struct termios));
11a39fe4 669 XSRETURN(1);
a0d0e21e
LW
670#else
671 not_here("termios");
672#endif
673 }
a0d0e21e
LW
674
675SysRet
676getattr(termios_ref, fd = 0)
677 POSIX::Termios termios_ref
678 int fd
679 CODE:
680 RETVAL = tcgetattr(fd, termios_ref);
681 OUTPUT:
682 RETVAL
683
e08f19f5
TC
684# If we define TCSANOW here then both a found and not found constant sub
685# are created causing a Constant subroutine TCSANOW redefined warning
518487b2 686#ifndef TCSANOW
e08f19f5
TC
687# define DEF_SETATTR_ACTION 0
688#else
689# define DEF_SETATTR_ACTION TCSANOW
518487b2 690#endif
a0d0e21e 691SysRet
e08f19f5 692setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
a0d0e21e
LW
693 POSIX::Termios termios_ref
694 int fd
695 int optional_actions
696 CODE:
518487b2
NC
697 /* The second argument to the call is mandatory, but we'd like to give
698 it a useful default. 0 isn't valid on all operating systems - on
699 Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
700 values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF. */
a0d0e21e
LW
701 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
702 OUTPUT:
703 RETVAL
704
705speed_t
2a59a32c 706getispeed(termios_ref)
a0d0e21e 707 POSIX::Termios termios_ref
2a59a32c
NC
708 ALIAS:
709 getospeed = 1
a0d0e21e 710 CODE:
2a59a32c 711 RETVAL = ix ? cfgetospeed(termios_ref) : cfgetispeed(termios_ref);
a0d0e21e
LW
712 OUTPUT:
713 RETVAL
714
715tcflag_t
2a59a32c 716getiflag(termios_ref)
a0d0e21e 717 POSIX::Termios termios_ref
2a59a32c
NC
718 ALIAS:
719 getoflag = 1
720 getcflag = 2
721 getlflag = 3
a0d0e21e
LW
722 CODE:
723#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
2a59a32c
NC
724 switch(ix) {
725 case 0:
726 RETVAL = termios_ref->c_iflag;
727 break;
728 case 1:
729 RETVAL = termios_ref->c_oflag;
730 break;
731 case 2:
732 RETVAL = termios_ref->c_cflag;
733 break;
734 case 3:
735 RETVAL = termios_ref->c_lflag;
736 break;
df164f52
DM
737 default:
738 RETVAL = 0; /* silence compiler warning */
2a59a32c 739 }
a0d0e21e 740#else
2a59a32c
NC
741 not_here(GvNAME(CvGV(cv)));
742 RETVAL = 0;
a0d0e21e
LW
743#endif
744 OUTPUT:
745 RETVAL
746
747cc_t
748getcc(termios_ref, ccix)
749 POSIX::Termios termios_ref
b56fc9ec 750 unsigned int ccix
a0d0e21e
LW
751 CODE:
752#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
753 if (ccix >= NCCS)
754 croak("Bad getcc subscript");
755 RETVAL = termios_ref->c_cc[ccix];
756#else
640cc986
HM
757 not_here("getcc");
758 RETVAL = 0;
a0d0e21e
LW
759#endif
760 OUTPUT:
761 RETVAL
762
763SysRet
2a59a32c 764setispeed(termios_ref, speed)
a0d0e21e
LW
765 POSIX::Termios termios_ref
766 speed_t speed
2a59a32c
NC
767 ALIAS:
768 setospeed = 1
a0d0e21e 769 CODE:
2a59a32c
NC
770 RETVAL = ix
771 ? cfsetospeed(termios_ref, speed) : cfsetispeed(termios_ref, speed);
772 OUTPUT:
773 RETVAL
a0d0e21e
LW
774
775void
2a59a32c 776setiflag(termios_ref, flag)
a0d0e21e 777 POSIX::Termios termios_ref
2a59a32c
NC
778 tcflag_t flag
779 ALIAS:
780 setoflag = 1
781 setcflag = 2
782 setlflag = 3
a0d0e21e
LW
783 CODE:
784#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
2a59a32c
NC
785 switch(ix) {
786 case 0:
787 termios_ref->c_iflag = flag;
788 break;
789 case 1:
790 termios_ref->c_oflag = flag;
791 break;
792 case 2:
793 termios_ref->c_cflag = flag;
794 break;
795 case 3:
796 termios_ref->c_lflag = flag;
797 break;
798 }
a0d0e21e 799#else
2a59a32c 800 not_here(GvNAME(CvGV(cv)));
a0d0e21e
LW
801#endif
802
803void
804setcc(termios_ref, ccix, cc)
805 POSIX::Termios termios_ref
b56fc9ec 806 unsigned int ccix
a0d0e21e
LW
807 cc_t cc
808 CODE:
809#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
810 if (ccix >= NCCS)
811 croak("Bad setcc subscript");
812 termios_ref->c_cc[ccix] = cc;
813#else
814 not_here("setcc");
815#endif
816
817
a0d0e21e
LW
818MODULE = POSIX PACKAGE = POSIX
819
1cb0fb50 820INCLUDE: const-xs.inc
a290f238 821
e99d581a
NC
822int
823WEXITSTATUS(status)
824 int status
72bfe1b2
NC
825 ALIAS:
826 POSIX::WIFEXITED = 1
827 POSIX::WIFSIGNALED = 2
828 POSIX::WIFSTOPPED = 3
829 POSIX::WSTOPSIG = 4
830 POSIX::WTERMSIG = 5
831 CODE:
fabb67aa
SK
832#if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
833 || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
19c4478c
NC
834 RETVAL = 0; /* Silence compilers that notice this, but don't realise
835 that not_here() can't return. */
836#endif
72bfe1b2
NC
837 switch(ix) {
838 case 0:
d49025b7 839#ifdef WEXITSTATUS
17028706 840 RETVAL = WEXITSTATUS(WMUNGE(status));
d49025b7
NC
841#else
842 not_here("WEXITSTATUS");
843#endif
72bfe1b2
NC
844 break;
845 case 1:
d49025b7 846#ifdef WIFEXITED
17028706 847 RETVAL = WIFEXITED(WMUNGE(status));
d49025b7
NC
848#else
849 not_here("WIFEXITED");
850#endif
72bfe1b2
NC
851 break;
852 case 2:
d49025b7 853#ifdef WIFSIGNALED
17028706 854 RETVAL = WIFSIGNALED(WMUNGE(status));
d49025b7
NC
855#else
856 not_here("WIFSIGNALED");
857#endif
72bfe1b2
NC
858 break;
859 case 3:
d49025b7 860#ifdef WIFSTOPPED
17028706 861 RETVAL = WIFSTOPPED(WMUNGE(status));
d49025b7
NC
862#else
863 not_here("WIFSTOPPED");
864#endif
72bfe1b2
NC
865 break;
866 case 4:
d49025b7 867#ifdef WSTOPSIG
17028706 868 RETVAL = WSTOPSIG(WMUNGE(status));
d49025b7
NC
869#else
870 not_here("WSTOPSIG");
871#endif
72bfe1b2
NC
872 break;
873 case 5:
d49025b7 874#ifdef WTERMSIG
17028706 875 RETVAL = WTERMSIG(WMUNGE(status));
d49025b7
NC
876#else
877 not_here("WTERMSIG");
878#endif
72bfe1b2
NC
879 break;
880 default:
c33e8be1 881 Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
72bfe1b2
NC
882 }
883 OUTPUT:
884 RETVAL
2304df62 885
2304df62
AD
886SysRet
887open(filename, flags = O_RDONLY, mode = 0666)
888 char * filename
889 int flags
a0d0e21e 890 Mode_t mode
748a9306
LW
891 CODE:
892 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
893 TAINT_PROPER("open");
894 RETVAL = open(filename, flags, mode);
895 OUTPUT:
896 RETVAL
897
2304df62
AD
898
899HV *
900localeconv()
901 CODE:
a0d0e21e 902#ifdef HAS_LOCALECONV
2304df62
AD
903 struct lconv *lcbuf;
904 RETVAL = newHV();
c4e79b56 905 sv_2mortal((SV*)RETVAL);
8063af02 906 if ((lcbuf = localeconv())) {
2f0945cb
NC
907 const struct lconv_offset *strings = lconv_strings;
908 const struct lconv_offset *integers = lconv_integers;
909 const char *ptr = (const char *) lcbuf;
910
911 do {
912 const char *value = *((const char **)(ptr + strings->offset));
913
914 if (value && *value)
915 (void) hv_store(RETVAL, strings->name, strlen(strings->name),
916 newSVpv(value, 0), 0);
917 } while ((++strings)->name);
918
919 do {
920 const char value = *((const char *)(ptr + integers->offset));
921
922 if (value != CHAR_MAX)
923 (void) hv_store(RETVAL, integers->name,
924 strlen(integers->name), newSViv(value), 0);
925 } while ((++integers)->name);
2304df62 926 }
a0d0e21e
LW
927#else
928 localeconv(); /* A stub to call not_here(). */
929#endif
2304df62
AD
930 OUTPUT:
931 RETVAL
932
933char *
c28ee57b 934setlocale(category, locale = 0)
2304df62
AD
935 int category
936 char * locale
1ba01ae3
SH
937 PREINIT:
938 char * retval;
c28ee57b 939 CODE:
b385bb4d
KW
940#ifdef WIN32 /* Use wrapper on Windows */
941 retval = Perl_my_setlocale(aTHX_ category, locale);
942#else
1ba01ae3 943 retval = setlocale(category, locale);
b385bb4d 944#endif
fbd840df
KW
945 if (! retval) {
946 XSRETURN_UNDEF;
947 }
948 else {
1ba01ae3
SH
949 /* Save retval since subsequent setlocale() calls
950 * may overwrite it. */
951 RETVAL = savepv(retval);
36477c24 952#ifdef USE_LOCALE_CTYPE
bbce6d69
PP
953 if (category == LC_CTYPE
954#ifdef LC_ALL
955 || category == LC_ALL
956#endif
957 )
958 {
959 char *newctype;
960#ifdef LC_ALL
961 if (category == LC_ALL)
962 newctype = setlocale(LC_CTYPE, NULL);
963 else
964#endif
965 newctype = RETVAL;
864dbfa3 966 new_ctype(newctype);
bbce6d69 967 }
36477c24
PP
968#endif /* USE_LOCALE_CTYPE */
969#ifdef USE_LOCALE_COLLATE
bbce6d69
PP
970 if (category == LC_COLLATE
971#ifdef LC_ALL
972 || category == LC_ALL
973#endif
974 )
975 {
976 char *newcoll;
977#ifdef LC_ALL
978 if (category == LC_ALL)
979 newcoll = setlocale(LC_COLLATE, NULL);
980 else
981#endif
982 newcoll = RETVAL;
864dbfa3 983 new_collate(newcoll);
bbce6d69 984 }
36477c24
PP
985#endif /* USE_LOCALE_COLLATE */
986#ifdef USE_LOCALE_NUMERIC
bbce6d69
PP
987 if (category == LC_NUMERIC
988#ifdef LC_ALL
989 || category == LC_ALL
990#endif
991 )
992 {
993 char *newnum;
994#ifdef LC_ALL
995 if (category == LC_ALL)
996 newnum = setlocale(LC_NUMERIC, NULL);
997 else
998#endif
999 newnum = RETVAL;
864dbfa3 1000 new_numeric(newnum);
bbce6d69 1001 }
36477c24 1002#endif /* USE_LOCALE_NUMERIC */
bbce6d69 1003 }
c28ee57b
JH
1004 OUTPUT:
1005 RETVAL
1ba01ae3 1006 CLEANUP:
fbd840df 1007 Safefree(RETVAL);
2304df62 1008
e1ca407b 1009NV
2304df62 1010acos(x)
e1ca407b 1011 NV x
b256643b
NC
1012 ALIAS:
1013 asin = 1
1014 atan = 2
1015 ceil = 3
1016 cosh = 4
1017 floor = 5
1018 log10 = 6
1019 sinh = 7
1020 tan = 8
1021 tanh = 9
1022 CODE:
1023 switch (ix) {
1024 case 0:
1025 RETVAL = acos(x);
1026 break;
1027 case 1:
1028 RETVAL = asin(x);
1029 break;
1030 case 2:
1031 RETVAL = atan(x);
1032 break;
1033 case 3:
1034 RETVAL = ceil(x);
1035 break;
1036 case 4:
1037 RETVAL = cosh(x);
1038 break;
1039 case 5:
1040 RETVAL = floor(x);
1041 break;
1042 case 6:
1043 RETVAL = log10(x);
1044 break;
1045 case 7:
1046 RETVAL = sinh(x);
1047 break;
1048 case 8:
1049 RETVAL = tan(x);
1050 break;
1051 default:
1052 RETVAL = tanh(x);
1053 }
1054 OUTPUT:
1055 RETVAL
2304df62 1056
e1ca407b 1057NV
2304df62 1058fmod(x,y)
e1ca407b
A
1059 NV x
1060 NV y
2304df62
AD
1061
1062void
1063frexp(x)
e1ca407b 1064 NV x
2304df62
AD
1065 PPCODE:
1066 int expvar;
2304df62
AD
1067 /* (We already know stack is long enough.) */
1068 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1069 PUSHs(sv_2mortal(newSViv(expvar)));
1070
e1ca407b 1071NV
2304df62 1072ldexp(x,exp)
e1ca407b 1073 NV x
2304df62
AD
1074 int exp
1075
2304df62
AD
1076void
1077modf(x)
e1ca407b 1078 NV x
2304df62 1079 PPCODE:
e1ca407b 1080 NV intvar;
2304df62 1081 /* (We already know stack is long enough.) */
bf4acbe4 1082 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
2304df62
AD
1083 PUSHs(sv_2mortal(newSVnv(intvar)));
1084
2304df62 1085SysRet
1dfe7606 1086sigaction(sig, optaction, oldaction = 0)
2304df62 1087 int sig
1dfe7606 1088 SV * optaction
2304df62
AD
1089 POSIX::SigAction oldaction
1090 CODE:
2986a63f 1091#if defined(WIN32) || defined(NETWARE)
6dead956
GS
1092 RETVAL = not_here("sigaction");
1093#else
2304df62
AD
1094# This code is really grody because we're trying to make the signal
1095# interface look beautiful, which is hard.
1096
2304df62 1097 {
27da23d5 1098 dVAR;
1dfe7606 1099 POSIX__SigAction action;
f584eb2d 1100 GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
2304df62
AD
1101 struct sigaction act;
1102 struct sigaction oact;
1dfe7606 1103 sigset_t sset;
183bde56 1104 SV *osset_sv;
27c1a449 1105 sigset_t osset;
2304df62
AD
1106 POSIX__SigSet sigset;
1107 SV** svp;
1d81eac9 1108 SV** sigsvp;
3609ea0d 1109
516d25e8
SP
1110 if (sig < 0) {
1111 croak("Negative signals are not allowed");
1112 }
1113
1d81eac9 1114 if (sig == 0 && SvPOK(ST(0))) {
aa07b2f6 1115 const char *s = SvPVX_const(ST(0));
1d81eac9
JH
1116 int i = whichsig(s);
1117
1118 if (i < 0 && memEQ(s, "SIG", 3))
1119 i = whichsig(s + 3);
1120 if (i < 0) {
1121 if (ckWARN(WARN_SIGNAL))
1122 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1123 "No such signal: SIG%s", s);
1124 XSRETURN_UNDEF;
1125 }
1126 else
1127 sig = i;
1128 }
3609ea0d
JH
1129#ifdef NSIG
1130 if (sig > NSIG) { /* NSIG - 1 is still okay. */
1131 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1132 "No such signal: %d", sig);
1133 XSRETURN_UNDEF;
1134 }
1135#endif
1d81eac9
JH
1136 sigsvp = hv_fetch(GvHVn(siggv),
1137 PL_sig_name[sig],
1138 strlen(PL_sig_name[sig]),
1139 TRUE);
2304df62 1140
1dfe7606 1141 /* Check optaction and set action */
1142 if(SvTRUE(optaction)) {
1143 if(sv_isa(optaction, "POSIX::SigAction"))
1144 action = (HV*)SvRV(optaction);
1145 else
1146 croak("action is not of type POSIX::SigAction");
1147 }
1148 else {
1149 action=0;
1150 }
1151
1152 /* sigaction() is supposed to look atomic. In particular, any
1153 * signal handler invoked during a sigaction() call should
1154 * see either the old or the new disposition, and not something
1155 * in between. We use sigprocmask() to make it so.
1156 */
1157 sigfillset(&sset);
1158 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1159 if(RETVAL == -1)
15c0d34a 1160 XSRETURN_UNDEF;
1dfe7606 1161 ENTER;
1162 /* Restore signal mask no matter how we exit this block. */
f584eb2d 1163 osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
183bde56 1164 SAVEFREESV( osset_sv );
40b7a5f5 1165 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1dfe7606 1166
1167 RETVAL=-1; /* In case both oldaction and action are 0. */
1168
1169 /* Remember old disposition if desired. */
2304df62 1170 if (oldaction) {
017a3ce5 1171 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1dfe7606 1172 if(!svp)
1173 croak("Can't supply an oldaction without a HANDLER");
1174 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1175 sv_setsv(*svp, *sigsvp);
1176 }
1177 else {
f584eb2d 1178 sv_setpvs(*svp, "DEFAULT");
1dfe7606 1179 }
1180 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
6ca4bbc9
GG
1181 if(RETVAL == -1) {
1182 LEAVE;
15c0d34a 1183 XSRETURN_UNDEF;
6ca4bbc9 1184 }
1dfe7606 1185 /* Get back the mask. */
017a3ce5 1186 svp = hv_fetchs(oldaction, "MASK", TRUE);
1dfe7606 1187 if (sv_isa(*svp, "POSIX::SigSet")) {
92b39396 1188 sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1dfe7606 1189 }
1190 else {
92b39396
NC
1191 sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
1192 sizeof(sigset_t),
1193 "POSIX::SigSet");
1dfe7606 1194 }
1195 *sigset = oact.sa_mask;
1196
1197 /* Get back the flags. */
017a3ce5 1198 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1dfe7606 1199 sv_setiv(*svp, oact.sa_flags);
d36b6582
CS
1200
1201 /* Get back whether the old handler used safe signals. */
017a3ce5 1202 svp = hv_fetchs(oldaction, "SAFE", TRUE);
e91e3b10
RB
1203 sv_setiv(*svp,
1204 /* compare incompatible pointers by casting to integer */
1205 PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
2304df62
AD
1206 }
1207
1208 if (action) {
d36b6582
CS
1209 /* Safe signals use "csighandler", which vectors through the
1210 PL_sighandlerp pointer when it's safe to do so.
1211 (BTW, "csighandler" is very different from "sighandler".) */
017a3ce5 1212 svp = hv_fetchs(action, "SAFE", FALSE);
e91e3b10
RB
1213 act.sa_handler =
1214 DPTR2FPTR(
87d46f97 1215 void (*)(int),
e91e3b10
RB
1216 (*svp && SvTRUE(*svp))
1217 ? PL_csighandlerp : PL_sighandlerp
1218 );
d36b6582
CS
1219
1220 /* Vector new Perl handler through %SIG.
1221 (The core signal handlers read %SIG to dispatch.) */
017a3ce5 1222 svp = hv_fetchs(action, "HANDLER", FALSE);
2304df62
AD
1223 if (!svp)
1224 croak("Can't supply an action without a HANDLER");
1dfe7606 1225 sv_setsv(*sigsvp, *svp);
d36b6582
CS
1226
1227 /* This call actually calls sigaction() with almost the
1228 right settings, including appropriate interpretation
1229 of DEFAULT and IGNORE. However, why are we doing
1230 this when we're about to do it again just below? XXX */
17cffb37 1231 SvSETMAGIC(*sigsvp);
d36b6582
CS
1232
1233 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1dfe7606 1234 if(SvPOK(*svp)) {
aa07b2f6 1235 const char *s=SvPVX_const(*svp);
1dfe7606 1236 if(strEQ(s,"IGNORE")) {
1237 act.sa_handler = SIG_IGN;
1238 }
1239 else if(strEQ(s,"DEFAULT")) {
1240 act.sa_handler = SIG_DFL;
1241 }
1dfe7606 1242 }
2304df62
AD
1243
1244 /* Set up any desired mask. */
017a3ce5 1245 svp = hv_fetchs(action, "MASK", FALSE);
2304df62 1246 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
92b39396 1247 sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
2304df62
AD
1248 act.sa_mask = *sigset;
1249 }
1250 else
85e6fe83 1251 sigemptyset(& act.sa_mask);
2304df62
AD
1252
1253 /* Set up any desired flags. */
017a3ce5 1254 svp = hv_fetchs(action, "FLAGS", FALSE);
2304df62 1255 act.sa_flags = svp ? SvIV(*svp) : 0;
2304df62 1256
1dfe7606 1257 /* Don't worry about cleaning up *sigsvp if this fails,
1258 * because that means we tried to disposition a
1259 * nonblockable signal, in which case *sigsvp is
1260 * essentially meaningless anyway.
1261 */
6c418a22 1262 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
6ca4bbc9
GG
1263 if(RETVAL == -1) {
1264 LEAVE;
a7aad5de 1265 XSRETURN_UNDEF;
6ca4bbc9 1266 }
2304df62 1267 }
1dfe7606 1268
1269 LEAVE;
2304df62 1270 }
6dead956 1271#endif
2304df62
AD
1272 OUTPUT:
1273 RETVAL
1274
1275SysRet
1276sigpending(sigset)
1277 POSIX::SigSet sigset
7a004119
NC
1278 ALIAS:
1279 sigsuspend = 1
1280 CODE:
1281 RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
1282 OUTPUT:
1283 RETVAL
20120e59
LT
1284 CLEANUP:
1285 PERL_ASYNC_CHECK();
2304df62
AD
1286
1287SysRet
1288sigprocmask(how, sigset, oldsigset = 0)
1289 int how
b13bbac7 1290 POSIX::SigSet sigset = NO_INIT
33c27489
GS
1291 POSIX::SigSet oldsigset = NO_INIT
1292INIT:
a3b811a7 1293 if (! SvOK(ST(1))) {
b13bbac7 1294 sigset = NULL;
a3b811a7 1295 } else if (sv_isa(ST(1), "POSIX::SigSet")) {
92b39396 1296 sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
b13bbac7
AB
1297 } else {
1298 croak("sigset is not of type POSIX::SigSet");
33c27489 1299 }
b13bbac7 1300
194cfca0 1301 if (items < 3 || ! SvOK(ST(2))) {
b13bbac7 1302 oldsigset = NULL;
a3b811a7 1303 } else if (sv_isa(ST(2), "POSIX::SigSet")) {
92b39396 1304 oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
b13bbac7
AB
1305 } else {
1306 croak("oldsigset is not of type POSIX::SigSet");
33c27489 1307 }
2304df62 1308
2304df62
AD
1309void
1310_exit(status)
1311 int status
8990e307 1312
85e6fe83 1313SysRet
8990e307
LW
1314dup2(fd1, fd2)
1315 int fd1
1316 int fd2
ad413e46
NC
1317 CODE:
1318#ifdef WIN32
1319 /* RT #98912 - More Microsoft muppetry - failing to actually implemented
1320 the well known documented POSIX behaviour for a POSIX API.
1321 http://msdn.microsoft.com/en-us/library/8syseb29.aspx */
1322 RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
1323#else
1324 RETVAL = dup2(fd1, fd2);
1325#endif
1326 OUTPUT:
1327 RETVAL
8990e307 1328
4a9d6100 1329SV *
a0d0e21e 1330lseek(fd, offset, whence)
85e6fe83
LW
1331 int fd
1332 Off_t offset
1333 int whence
4a9d6100
GS
1334 CODE:
1335 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1336 RETVAL = sizeof(Off_t) > sizeof(IV)
1337 ? newSVnv((NV)pos) : newSViv((IV)pos);
1338 OUTPUT:
1339 RETVAL
8990e307 1340
c5661c80 1341void
8990e307
LW
1342nice(incr)
1343 int incr
15f0f28a
AE
1344 PPCODE:
1345 errno = 0;
1346 if ((incr = nice(incr)) != -1 || errno == 0) {
1347 if (incr == 0)
d3d34884 1348 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
15f0f28a
AE
1349 else
1350 XPUSHs(sv_2mortal(newSViv(incr)));
1351 }
8990e307 1352
8063af02 1353void
8990e307 1354pipe()
85e6fe83
LW
1355 PPCODE:
1356 int fds[2];
85e6fe83 1357 if (pipe(fds) != -1) {
924508f0 1358 EXTEND(SP,2);
85e6fe83
LW
1359 PUSHs(sv_2mortal(newSViv(fds[0])));
1360 PUSHs(sv_2mortal(newSViv(fds[1])));
1361 }
8990e307 1362
85e6fe83 1363SysRet
a0d0e21e 1364read(fd, buffer, nbytes)
7747499c
TB
1365 PREINIT:
1366 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1367 INPUT:
1368 int fd
1369 size_t nbytes
1370 char * buffer = sv_grow( sv_buffer, nbytes+1 );
a0d0e21e 1371 CLEANUP:
7747499c 1372 if (RETVAL >= 0) {
b162af07 1373 SvCUR_set(sv_buffer, RETVAL);
7747499c
TB
1374 SvPOK_only(sv_buffer);
1375 *SvEND(sv_buffer) = '\0';
bbce6d69 1376 SvTAINTED_on(sv_buffer);
7747499c 1377 }
8990e307 1378
85e6fe83 1379SysRet
8990e307 1380setpgid(pid, pgid)
86200d5c
JH
1381 pid_t pid
1382 pid_t pgid
8990e307 1383
86200d5c 1384pid_t
8990e307
LW
1385setsid()
1386
86200d5c 1387pid_t
8990e307
LW
1388tcgetpgrp(fd)
1389 int fd
1390
85e6fe83 1391SysRet
8990e307
LW
1392tcsetpgrp(fd, pgrp_id)
1393 int fd
86200d5c 1394 pid_t pgrp_id
8990e307 1395
8063af02 1396void
8990e307 1397uname()
2304df62 1398 PPCODE:
a0d0e21e 1399#ifdef HAS_UNAME
85e6fe83 1400 struct utsname buf;
85e6fe83 1401 if (uname(&buf) >= 0) {
924508f0 1402 EXTEND(SP, 5);
d3d34884
NC
1403 PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
1404 PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
1405 PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
1406 PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
1407 PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
8990e307 1408 }
a0d0e21e
LW
1409#else
1410 uname((char *) 0); /* A stub to call not_here(). */
1411#endif
8990e307 1412
85e6fe83 1413SysRet
a0d0e21e
LW
1414write(fd, buffer, nbytes)
1415 int fd
1416 char * buffer
1417 size_t nbytes
1418
33f01dd1
SH
1419SV *
1420tmpnam()
1421 PREINIT:
1422 STRLEN i;
1423 int len;
1424 CODE:
1425 RETVAL = newSVpvn("", 0);
1426 SvGROW(RETVAL, L_tmpnam);
1427 len = strlen(tmpnam(SvPV(RETVAL, i)));
1428 SvCUR_set(RETVAL, len);
1429 OUTPUT:
1430 RETVAL
a0d0e21e
LW
1431
1432void
1433abort()
1434
1435int
1436mblen(s, n)
1437 char * s
1438 size_t n
1439
1440size_t
1441mbstowcs(s, pwcs, n)
1442 wchar_t * s
1443 char * pwcs
1444 size_t n
1445
1446int
1447mbtowc(pwc, s, n)
1448 wchar_t * pwc
1449 char * s
1450 size_t n
1451
1452int
1453wcstombs(s, pwcs, n)
1454 char * s
1455 wchar_t * pwcs
1456 size_t n
1457
1458int
1459wctomb(s, wchar)
1460 char * s
1461 wchar_t wchar
1462
1463int
1464strcoll(s1, s2)
1465 char * s1
1466 char * s2
1467
a89d8a78
DH
1468void
1469strtod(str)
1470 char * str
1471 PREINIT:
1472 double num;
1473 char *unparsed;
1474 PPCODE:
371d5d44 1475 STORE_NUMERIC_STANDARD_FORCE_LOCAL();
a89d8a78
DH
1476 num = strtod(str, &unparsed);
1477 PUSHs(sv_2mortal(newSVnv(num)));
1478 if (GIMME == G_ARRAY) {
924508f0 1479 EXTEND(SP, 1);
a89d8a78
DH
1480 if (unparsed)
1481 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1482 else
6b88bc9c 1483 PUSHs(&PL_sv_undef);
a89d8a78 1484 }
371d5d44 1485 RESTORE_NUMERIC_STANDARD();
a89d8a78
DH
1486
1487void
1488strtol(str, base = 0)
1489 char * str
1490 int base
1491 PREINIT:
1492 long num;
1493 char *unparsed;
1494 PPCODE:
1495 num = strtol(str, &unparsed, base);
42718184
RB
1496#if IVSIZE <= LONGSIZE
1497 if (num < IV_MIN || num > IV_MAX)
a89d8a78 1498 PUSHs(sv_2mortal(newSVnv((double)num)));
42718184
RB
1499 else
1500#endif
1501 PUSHs(sv_2mortal(newSViv((IV)num)));
a89d8a78 1502 if (GIMME == G_ARRAY) {
924508f0 1503 EXTEND(SP, 1);
a89d8a78
DH
1504 if (unparsed)
1505 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1506 else
6b88bc9c 1507 PUSHs(&PL_sv_undef);
a89d8a78
DH
1508 }
1509
1510void
1511strtoul(str, base = 0)
4b48cf39 1512 const char * str
a89d8a78
DH
1513 int base
1514 PREINIT:
1515 unsigned long num;
1516 char *unparsed;
1517 PPCODE:
1518 num = strtoul(str, &unparsed, base);
84c133a0
RB
1519#if IVSIZE <= LONGSIZE
1520 if (num > IV_MAX)
a89d8a78 1521 PUSHs(sv_2mortal(newSVnv((double)num)));
84c133a0
RB
1522 else
1523#endif
1524 PUSHs(sv_2mortal(newSViv((IV)num)));
a89d8a78 1525 if (GIMME == G_ARRAY) {
924508f0 1526 EXTEND(SP, 1);
a89d8a78
DH
1527 if (unparsed)
1528 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1529 else
6b88bc9c 1530 PUSHs(&PL_sv_undef);
a89d8a78
DH
1531 }
1532
8063af02 1533void
a0d0e21e
LW
1534strxfrm(src)
1535 SV * src
85e6fe83 1536 CODE:
a0d0e21e
LW
1537 {
1538 STRLEN srclen;
1539 STRLEN dstlen;
1540 char *p = SvPV(src,srclen);
1541 srclen++;
561b68a9 1542 ST(0) = sv_2mortal(newSV(srclen*4+1));
a0d0e21e
LW
1543 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1544 if (dstlen > srclen) {
1545 dstlen++;
1546 SvGROW(ST(0), dstlen);
1547 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1548 dstlen--;
1549 }
b162af07 1550 SvCUR_set(ST(0), dstlen);
a0d0e21e
LW
1551 SvPOK_only(ST(0));
1552 }
1553
1554SysRet
1555mkfifo(filename, mode)
1556 char * filename
1557 Mode_t mode
b5890904
NC
1558 ALIAS:
1559 access = 1
748a9306 1560 CODE:
b5890904
NC
1561 if(ix) {
1562 RETVAL = access(filename, mode);
1563 } else {
1564 TAINT_PROPER("mkfifo");
1565 RETVAL = mkfifo(filename, mode);
1566 }
748a9306
LW
1567 OUTPUT:
1568 RETVAL
a0d0e21e
LW
1569
1570SysRet
1571tcdrain(fd)
1572 int fd
9163475a
NC
1573 ALIAS:
1574 close = 1
1575 dup = 2
1576 CODE:
1577 RETVAL = ix == 1 ? close(fd)
1578 : (ix < 1 ? tcdrain(fd) : dup(fd));
1579 OUTPUT:
1580 RETVAL
a0d0e21e
LW
1581
1582
1583SysRet
1584tcflow(fd, action)
1585 int fd
1586 int action
7a004119
NC
1587 ALIAS:
1588 tcflush = 1
1589 tcsendbreak = 2
1590 CODE:
1591 RETVAL = ix == 1 ? tcflush(fd, action)
1592 : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
1593 OUTPUT:
1594 RETVAL
a0d0e21e 1595
250d97fd 1596void
c1646883 1597asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
a0d0e21e
LW
1598 int sec
1599 int min
1600 int hour
1601 int mday
1602 int mon
1603 int year
1604 int wday
1605 int yday
1606 int isdst
250d97fd
NC
1607 ALIAS:
1608 mktime = 1
1609 PPCODE:
a0d0e21e 1610 {
250d97fd 1611 dXSTARG;
a0d0e21e 1612 struct tm mytm;
a748fe11 1613 init_tm(&mytm); /* XXX workaround - see init_tm() in core util.c */
a0d0e21e
LW
1614 mytm.tm_sec = sec;
1615 mytm.tm_min = min;
1616 mytm.tm_hour = hour;
1617 mytm.tm_mday = mday;
1618 mytm.tm_mon = mon;
1619 mytm.tm_year = year;
1620 mytm.tm_wday = wday;
1621 mytm.tm_yday = yday;
1622 mytm.tm_isdst = isdst;
250d97fd 1623 if (ix) {
e2054bce
TC
1624 const time_t result = mktime(&mytm);
1625 if (result == (time_t)-1)
250d97fd
NC
1626 SvOK_off(TARG);
1627 else if (result == 0)
1628 sv_setpvn(TARG, "0 but true", 10);
1629 else
1630 sv_setiv(TARG, (IV)result);
1631 } else {
1632 sv_setpv(TARG, asctime(&mytm));
1633 }
1634 ST(0) = TARG;
1635 XSRETURN(1);
a0d0e21e 1636 }
a0d0e21e
LW
1637
1638long
1639clock()
1640
1641char *
1642ctime(time)
748a9306 1643 Time_t &time
8990e307 1644
37120919
AD
1645void
1646times()
1647 PPCODE:
1648 struct tms tms;
1649 clock_t realtime;
1650 realtime = times( &tms );
924508f0 1651 EXTEND(SP,5);
9607fc9c
PP
1652 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1653 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1654 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1655 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1656 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
37120919 1657
a0d0e21e
LW
1658double
1659difftime(time1, time2)
1660 Time_t time1
1661 Time_t time2
1662
8063af02
DM
1663#XXX: if $xsubpp::WantOptimize is always the default
1664# sv_setpv(TARG, ...) could be used rather than
1665# ST(0) = sv_2mortal(newSVpv(...))
1666void
e44f695e 1667strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
dc57de01 1668 SV * fmt
a0d0e21e
LW
1669 int sec
1670 int min
1671 int hour
1672 int mday
1673 int mon
1674 int year
1675 int wday
1676 int yday
1677 int isdst
1678 CODE:
1679 {
5d37acd6
DM
1680 char *buf;
1681
1682 /* allowing user-supplied (rather than literal) formats
1683 * is normally frowned upon as a potential security risk;
1684 * but this is part of the API so we have to allow it */
1685 GCC_DIAG_IGNORE(-Wformat-nonliteral);
1686 buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
1687 GCC_DIAG_RESTORE;
2a74cb2d 1688 if (buf) {
8dbe7cf7
NC
1689 SV *const sv = sv_newmortal();
1690 sv_usepvn_flags(sv, buf, strlen(buf), SV_HAS_TRAILING_NUL);
1691 if (SvUTF8(fmt)) {
1692 SvUTF8_on(sv);
1693 }
1694 ST(0) = sv;
2a74cb2d 1695 }
a0d0e21e
LW
1696 }
1697
1698void
1699tzset()
81ab4c44
SH
1700 PPCODE:
1701 my_tzset(aTHX);
a0d0e21e
LW
1702
1703void
1704tzname()
1705 PPCODE:
924508f0 1706 EXTEND(SP,2);
d3d34884
NC
1707 PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
1708 PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
a0d0e21e 1709
a0d0e21e
LW
1710char *
1711ctermid(s = 0)
3ab23a19
RGS
1712 char * s = 0;
1713 CODE:
1714#ifdef HAS_CTERMID_R
e02b9112 1715 s = (char *) safemalloc((size_t) L_ctermid);
3ab23a19
RGS
1716#endif
1717 RETVAL = ctermid(s);
1718 OUTPUT:
1719 RETVAL
d1fd7089 1720 CLEANUP:
3ab23a19 1721#ifdef HAS_CTERMID_R
d1fd7089 1722 Safefree(s);
3ab23a19 1723#endif
a0d0e21e
LW
1724
1725char *
1726cuserid(s = 0)
1727 char * s = 0;
56f4542c
TJ
1728 CODE:
1729#ifdef HAS_CUSERID
1730 RETVAL = cuserid(s);
1731#else
1732 RETVAL = 0;
1733 not_here("cuserid");
1734#endif
1735 OUTPUT:
1736 RETVAL
a0d0e21e
LW
1737
1738SysRetLong
1739fpathconf(fd, name)
1740 int fd
1741 int name
1742
1743SysRetLong
1744pathconf(filename, name)
1745 char * filename
1746 int name
1747
1748SysRet
1749pause()
20120e59
LT
1750 CLEANUP:
1751 PERL_ASYNC_CHECK();
a0d0e21e 1752
a387c53a
NC
1753unsigned int
1754sleep(seconds)
1755 unsigned int seconds
1756 CODE:
1757 RETVAL = PerlProc_sleep(seconds);
1758 OUTPUT:
1759 RETVAL
1760
a043a685
GW
1761SysRet
1762setgid(gid)
1763 Gid_t gid
1764
1765SysRet
1766setuid(uid)
1767 Uid_t uid
1768
a0d0e21e
LW
1769SysRetLong
1770sysconf(name)
1771 int name
1772
1773char *
1774ttyname(fd)
1775 int fd
a043a685 1776
c6c619a9 1777void
b5846a0b 1778getcwd()
8f95b30d
JH
1779 PPCODE:
1780 {
1781 dXSTARG;
89423764 1782 getcwd_sv(TARG);
8f95b30d
JH
1783 XSprePUSH; PUSHTARG;
1784 }
1785
0d7021f5
RGS
1786SysRet
1787lchown(uid, gid, path)
1788 Uid_t uid
1789 Gid_t gid
1790 char * path
1791 CODE:
1792#ifdef HAS_LCHOWN
1793 /* yes, the order of arguments is different,
1794 * but consistent with CORE::chown() */
1795 RETVAL = lchown(path, uid, gid);
1796#else
1797 RETVAL = not_here("lchown");
1798#endif
1799 OUTPUT:
1800 RETVAL