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