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