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