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