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
11 #include <sys/utsname.h>
14 #define PERL_NO_GET_CONTEXT
17 #define PERLIO_NOT_STDIO 1
20 #if defined(PERL_IMPLICIT_SYS)
24 # define open PerlLIO_open3
27 #ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */
54 /* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
55 metaconfig for future extension writers. We don't use them in POSIX.
56 (This is really sneaky :-) --AD
58 #if defined(I_TERMIOS)
68 #include <sys/types.h>
76 # if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
77 extern char *tzname[];
80 #if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
81 char *tzname[] = { "" , "" };
85 #ifndef PERL_UNUSED_DECL
87 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
88 # define PERL_UNUSED_DECL
90 # define PERL_UNUSED_DECL __attribute__((unused))
93 # define PERL_UNUSED_DECL
98 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL
105 #if defined(__VMS) && !defined(__POSIX_SOURCE)
106 # include <libdef.h> /* LIB$_INVARG constant */
107 # include <lib$routines.h> /* prototype for lib$ediv() */
108 # include <starlet.h> /* prototype for sys$gettim() */
109 # if DECC_VERSION < 50000000
110 # define pid_t int /* old versions of DECC miss this in types.h */
114 # define mkfifo(a,b) (not_here("mkfifo"),-1)
115 # define tzset() not_here("tzset")
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>
120 # endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
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)
126 /* The non-POSIX CRTL times() has void return type, so we just get the
127 current time directly */
128 clock_t vms_times(struct tms *bufptr) {
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)
136 _ckvmssts(sys$gettim(&vmstime));
138 retval = vmstime & 0x7fffffff;
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));
148 /* Fill in the struct tms using the CRTL routine . . .*/
149 times((tbuffer_t *)bufptr);
150 return (clock_t) retval;
152 # define times(t) vms_times(t)
154 #if defined (__CYGWIN__)
155 # define tzname _tzname
157 #if defined (WIN32) || defined (NETWARE)
159 # define mkfifo(a,b) not_here("mkfifo")
160 # define ttyname(a) (char*)not_here("ttyname")
161 # define sigset_t long
164 # define tzname _tzname
167 # define mode_t short
170 # define mode_t short
172 # define tzset() not_here("tzset")
174 # ifndef _POSIX_OPEN_MAX
175 # define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
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")
190 # define setuid(a) not_here("setuid")
191 # define setgid(a) not_here("setgid")
197 # define mkfifo(a,b) not_here("mkfifo")
198 # else /* !( defined OS2 ) */
200 # define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
203 # endif /* !HAS_MKFIFO */
208 # include <sys/times.h>
210 # include <sys/utsname.h>
212 # include <sys/wait.h>
216 #endif /* WIN32 || NETWARE */
220 /* Perl on Windows assigns WSAGetLastError() return values to errno
221 * (in win32/win32sck.c). Therefore we need to map these values
222 * back to standard symbolic names, as long as the same name isn't
223 * already defined by errno.h itself. The Errno.pm module does
227 # define EWOULDBLOCK WSAEWOULDBLOCK
230 # define EINPROGRESS WSAEINPROGRESS
233 # define EALREADY WSAEALREADY
236 # define ENOTSOCK WSAENOTSOCK
238 # ifndef EDESTADDRREQ
239 # define EDESTADDRREQ WSAEDESTADDRREQ
242 # define EMSGSIZE WSAEMSGSIZE
245 # define EPROTOTYPE WSAEPROTOTYPE
248 # define ENOPROTOOPT WSAENOPROTOOPT
250 # ifndef EPROTONOSUPPORT
251 # define EPROTONOSUPPORT WSAEPROTONOSUPPORT
253 # ifndef ESOCKTNOSUPPORT
254 # define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
257 # define EOPNOTSUPP WSAEOPNOTSUPP
259 # ifndef EPFNOSUPPORT
260 # define EPFNOSUPPORT WSAEPFNOSUPPORT
262 # ifndef EAFNOSUPPORT
263 # define EAFNOSUPPORT WSAEAFNOSUPPORT
266 # define EADDRINUSE WSAEADDRINUSE
268 # ifndef EADDRNOTAVAIL
269 # define EADDRNOTAVAIL WSAEADDRNOTAVAIL
272 # define ENETDOWN WSAENETDOWN
275 # define ENETUNREACH WSAENETUNREACH
278 # define ENETRESET WSAENETRESET
280 # ifndef ECONNABORTED
281 # define ECONNABORTED WSAECONNABORTED
284 # define ECONNRESET WSAECONNRESET
287 # define ENOBUFS WSAENOBUFS
290 # define EISCONN WSAEISCONN
293 # define ENOTCONN WSAENOTCONN
296 # define ESHUTDOWN WSAESHUTDOWN
298 # ifndef ETOOMANYREFS
299 # define ETOOMANYREFS WSAETOOMANYREFS
302 # define ETIMEDOUT WSAETIMEDOUT
304 # ifndef ECONNREFUSED
305 # define ECONNREFUSED WSAECONNREFUSED
308 # define ELOOP WSAELOOP
310 # ifndef ENAMETOOLONG
311 # define ENAMETOOLONG WSAENAMETOOLONG
314 # define EHOSTDOWN WSAEHOSTDOWN
316 # ifndef EHOSTUNREACH
317 # define EHOSTUNREACH WSAEHOSTUNREACH
320 # define ENOTEMPTY WSAENOTEMPTY
323 # define EPROCLIM WSAEPROCLIM
326 # define EUSERS WSAEUSERS
329 # define EDQUOT WSAEDQUOT
332 # define ESTALE WSAESTALE
335 # define EREMOTE WSAEREMOTE
338 # define EDISCON WSAEDISCON
343 typedef long SysRetLong;
344 typedef sigset_t* POSIX__SigSet;
345 typedef HV* POSIX__SigAction;
347 typedef struct termios* POSIX__Termios;
348 #else /* Define termios types to int, and call not_here for the functions.*/
349 #define POSIX__Termios int
353 #define cfgetispeed(x) not_here("cfgetispeed")
354 #define cfgetospeed(x) not_here("cfgetospeed")
355 #define tcdrain(x) not_here("tcdrain")
356 #define tcflush(x,y) not_here("tcflush")
357 #define tcsendbreak(x,y) not_here("tcsendbreak")
358 #define cfsetispeed(x,y) not_here("cfsetispeed")
359 #define cfsetospeed(x,y) not_here("cfsetospeed")
360 #define ctermid(x) (char *) not_here("ctermid")
361 #define tcflow(x,y) not_here("tcflow")
362 #define tcgetattr(x,y) not_here("tcgetattr")
363 #define tcsetattr(x,y,z) not_here("tcsetattr")
366 /* Possibly needed prototypes */
368 double strtod (const char *, char **);
369 long strtol (const char *, char **, int);
370 unsigned long strtoul (const char *, char **, int);
375 #define difftime(a,b) not_here("difftime")
378 #ifndef HAS_FPATHCONF
379 #define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
382 #define mktime(a) not_here("mktime")
385 #define nice(a) not_here("nice")
388 #define pathconf(f,n) (SysRetLong) not_here("pathconf")
391 #define sysconf(n) (SysRetLong) not_here("sysconf")
394 #define readlink(a,b,c) not_here("readlink")
397 #define setpgid(a,b) not_here("setpgid")
400 #define setsid() not_here("setsid")
403 #define strcoll(s1,s2) not_here("strcoll")
406 #define strtod(s1,s2) not_here("strtod")
409 #define strtol(s1,s2,b) not_here("strtol")
412 #define strtoul(s1,s2,b) not_here("strtoul")
415 #define strxfrm(s1,s2,n) not_here("strxfrm")
417 #ifndef HAS_TCGETPGRP
418 #define tcgetpgrp(a) not_here("tcgetpgrp")
420 #ifndef HAS_TCSETPGRP
421 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
425 #define times(a) not_here("times")
429 #define uname(a) not_here("uname")
432 #define waitpid(a,b,c) not_here("waitpid")
437 #define mblen(a,b) not_here("mblen")
441 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
444 #define mbtowc(pwc, s, n) not_here("mbtowc")
447 #define wcstombs(s, pwcs, n) not_here("wcstombs")
450 #define wctomb(s, wchar) not_here("wcstombs")
452 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
453 /* If we don't have these functions, then we wouldn't have gotten a typedef
454 for wchar_t, the wide character type. Defining wchar_t allows the
455 functions referencing it to compile. Its actual type is then meaningless,
456 since without the above functions, all sections using it end up calling
457 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
463 #ifndef HAS_LOCALECONV
464 #define localeconv() not_here("localeconv")
467 #ifdef HAS_LONG_DOUBLE
468 # if LONG_DOUBLESIZE > NVSIZE
469 # undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
473 #ifndef HAS_LONG_DOUBLE
485 /* Background: in most systems the low byte of the wait status
486 * is the signal (the lowest 7 bits) and the coredump flag is
487 * the eight bit, and the second lowest byte is the exit status.
488 * BeOS bucks the trend and has the bytes in different order.
489 * See beos/beos.c for how the reality is bent even in BeOS
490 * to follow the traditional. However, to make the POSIX
491 * wait W*() macros to work in BeOS, we need to unbend the
492 * reality back in place. --jhi */
493 /* In actual fact the code below is to blame here. Perl has an internal
494 * representation of the exit status ($?), which it re-composes from the
495 * OS's representation using the W*() POSIX macros. The code below
496 * incorrectly uses the W*() macros on the internal representation,
497 * which fails for OSs that have a different representation (namely BeOS
498 * and Haiku). WMUNGE() is a hack that converts the internal
499 * representation into the OS specific one, so that the W*() macros work
500 * as expected. The better solution would be not to use the W*() macros
501 * in the first place, though. -- Ingo Weinhold
503 #if defined(__BEOS__) || defined(__HAIKU__)
504 # define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
506 # define WMUNGE(x) (x)
510 not_here(const char *s)
512 croak("POSIX::%s not implemented on this architecture", s);
516 #include "const-c.inc"
519 restore_sigmask(pTHX_ SV *osset_sv)
521 /* Fortunately, restoring the signal mask can't fail, because
522 * there's nothing we can do about it if it does -- we're not
523 * supposed to return -1 from sigaction unless the disposition
526 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
527 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
533 * (1) The CRT maintains its own copy of the environment, separate from
536 * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
537 * copy, and then calls SetEnvironmentVariableA() to update the Win32API
540 * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
541 * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
544 * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
545 * calls CRT tzset(), but only the first time it is called, and in turn
546 * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
547 * local copy of the environment and hence gets the original setting as
548 * perl never updates the CRT copy when assigning to $ENV{TZ}.
550 * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
551 * putenv() to update the CRT copy of the environment (if it is different)
552 * whenever we're about to call tzset().
554 * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
557 * (a) Each interpreter has its own copy of the environment inside the
558 * perlhost structure. That allows applications that host multiple
559 * independent Perl interpreters to isolate environment changes from
560 * each other. (This is similar to how the perlhost mechanism keeps a
561 * separate working directory for each Perl interpreter, so that calling
562 * chdir() will not affect other interpreters.)
564 * (b) Only the first Perl interpreter instantiated within a process will
565 * "write through" environment changes to the process environment.
567 * (c) Even the primary Perl interpreter won't update the CRT copy of the
568 * the environment, only the Win32API copy (it calls win32_putenv()).
570 * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
571 * sense to only update the process environment when inside the main
572 * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
573 * from here so we'll just have to check PL_curinterp instead.
575 * Therefore, we can simply #undef getenv() and putenv() so that those names
576 * always refer to the CRT functions, and explicitly call win32_getenv() to
577 * access perl's %ENV.
579 * We also #undef malloc() and free() to be sure we are using the CRT
580 * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
581 * into VMem::Malloc() and VMem::Free() and all allocations will be freed
582 * when the Perl interpreter is being destroyed so we'd end up with a pointer
583 * into deallocated memory in environ[] if a program embedding a Perl
584 * interpreter continues to operate even after the main Perl interpreter has
587 * Note that we don't free() the malloc()ed memory unless and until we call
588 * malloc() again ourselves because the CRT putenv() function simply puts its
589 * pointer argument into the environ[] arrary (it doesn't make a copy of it)
590 * so this memory must otherwise be leaked.
599 fix_win32_tzenv(void)
601 static char* oldenv = NULL;
603 const char* perl_tz_env = win32_getenv("TZ");
604 const char* crt_tz_env = getenv("TZ");
605 if (perl_tz_env == NULL)
607 if (crt_tz_env == NULL)
609 if (strcmp(perl_tz_env, crt_tz_env) != 0) {
610 newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
611 if (newenv != NULL) {
612 sprintf(newenv, "TZ=%s", perl_tz_env);
624 * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
625 * This code is duplicated in the Time-Piece module, so any changes made here
626 * should be made there too.
632 #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
633 if (PL_curinterp == aTHX)
640 MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
643 new(packname = "POSIX::SigSet", ...)
644 const char * packname
648 Newx(RETVAL, 1, sigset_t);
650 for (i = 1; i < items; i++)
651 sigaddset(RETVAL, SvIV(ST(i)));
663 sigaddset(sigset, sig)
668 sigdelset(sigset, sig)
681 sigismember(sigset, sig)
685 MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
688 new(packname = "POSIX::Termios", ...)
689 const char * packname
693 Newx(RETVAL, 1, struct termios);
704 POSIX::Termios termios_ref
707 Safefree(termios_ref);
713 getattr(termios_ref, fd = 0)
714 POSIX::Termios termios_ref
717 RETVAL = tcgetattr(fd, termios_ref);
722 setattr(termios_ref, fd = 0, optional_actions = 0)
723 POSIX::Termios termios_ref
727 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
732 cfgetispeed(termios_ref)
733 POSIX::Termios termios_ref
736 cfgetospeed(termios_ref)
737 POSIX::Termios termios_ref
740 getiflag(termios_ref)
741 POSIX::Termios termios_ref
743 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
744 RETVAL = termios_ref->c_iflag;
746 not_here("getiflag");
753 getoflag(termios_ref)
754 POSIX::Termios termios_ref
756 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
757 RETVAL = termios_ref->c_oflag;
759 not_here("getoflag");
766 getcflag(termios_ref)
767 POSIX::Termios termios_ref
769 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
770 RETVAL = termios_ref->c_cflag;
772 not_here("getcflag");
779 getlflag(termios_ref)
780 POSIX::Termios termios_ref
782 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
783 RETVAL = termios_ref->c_lflag;
785 not_here("getlflag");
792 getcc(termios_ref, ccix)
793 POSIX::Termios termios_ref
796 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
798 croak("Bad getcc subscript");
799 RETVAL = termios_ref->c_cc[ccix];
808 cfsetispeed(termios_ref, speed)
809 POSIX::Termios termios_ref
813 cfsetospeed(termios_ref, speed)
814 POSIX::Termios termios_ref
818 setiflag(termios_ref, iflag)
819 POSIX::Termios termios_ref
822 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
823 termios_ref->c_iflag = iflag;
825 not_here("setiflag");
829 setoflag(termios_ref, oflag)
830 POSIX::Termios termios_ref
833 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
834 termios_ref->c_oflag = oflag;
836 not_here("setoflag");
840 setcflag(termios_ref, cflag)
841 POSIX::Termios termios_ref
844 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
845 termios_ref->c_cflag = cflag;
847 not_here("setcflag");
851 setlflag(termios_ref, lflag)
852 POSIX::Termios termios_ref
855 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
856 termios_ref->c_lflag = lflag;
858 not_here("setlflag");
862 setcc(termios_ref, ccix, cc)
863 POSIX::Termios termios_ref
867 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
869 croak("Bad setcc subscript");
870 termios_ref->c_cc[ccix] = cc;
876 MODULE = POSIX PACKAGE = POSIX
878 INCLUDE: const-xs.inc
885 POSIX::WIFSIGNALED = 2
886 POSIX::WIFSTOPPED = 3
890 #if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
891 || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
892 RETVAL = 0; /* Silence compilers that notice this, but don't realise
893 that not_here() can't return. */
898 RETVAL = WEXITSTATUS(WMUNGE(status));
900 not_here("WEXITSTATUS");
905 RETVAL = WIFEXITED(WMUNGE(status));
907 not_here("WIFEXITED");
912 RETVAL = WIFSIGNALED(WMUNGE(status));
914 not_here("WIFSIGNALED");
919 RETVAL = WIFSTOPPED(WMUNGE(status));
921 not_here("WIFSTOPPED");
926 RETVAL = WSTOPSIG(WMUNGE(status));
928 not_here("WSTOPSIG");
933 RETVAL = WTERMSIG(WMUNGE(status));
935 not_here("WTERMSIG");
939 Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", ix);
950 unsigned char *s = (unsigned char *) SvPV(charstring, len);
951 unsigned char *e = s + len;
952 for (RETVAL = 1; RETVAL && s < e; s++)
964 unsigned char *s = (unsigned char *) SvPV(charstring, len);
965 unsigned char *e = s + len;
966 for (RETVAL = 1; RETVAL && s < e; s++)
978 unsigned char *s = (unsigned char *) SvPV(charstring, len);
979 unsigned char *e = s + len;
980 for (RETVAL = 1; RETVAL && s < e; s++)
992 unsigned char *s = (unsigned char *) SvPV(charstring, len);
993 unsigned char *e = s + len;
994 for (RETVAL = 1; RETVAL && s < e; s++)
1006 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1007 unsigned char *e = s + len;
1008 for (RETVAL = 1; RETVAL && s < e; s++)
1020 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1021 unsigned char *e = s + len;
1022 for (RETVAL = 1; RETVAL && s < e; s++)
1034 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1035 unsigned char *e = s + len;
1036 for (RETVAL = 1; RETVAL && s < e; s++)
1048 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1049 unsigned char *e = s + len;
1050 for (RETVAL = 1; RETVAL && s < e; s++)
1062 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1063 unsigned char *e = s + len;
1064 for (RETVAL = 1; RETVAL && s < e; s++)
1076 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1077 unsigned char *e = s + len;
1078 for (RETVAL = 1; RETVAL && s < e; s++)
1085 isxdigit(charstring)
1090 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1091 unsigned char *e = s + len;
1092 for (RETVAL = 1; RETVAL && s < e; s++)
1099 open(filename, flags = O_RDONLY, mode = 0666)
1104 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
1105 TAINT_PROPER("open");
1106 RETVAL = open(filename, flags, mode);
1114 #ifdef HAS_LOCALECONV
1115 struct lconv *lcbuf;
1117 sv_2mortal((SV*)RETVAL);
1118 if ((lcbuf = localeconv())) {
1120 if (lcbuf->decimal_point && *lcbuf->decimal_point)
1121 hv_store(RETVAL, "decimal_point", 13,
1122 newSVpv(lcbuf->decimal_point, 0), 0);
1123 if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
1124 hv_store(RETVAL, "thousands_sep", 13,
1125 newSVpv(lcbuf->thousands_sep, 0), 0);
1126 #ifndef NO_LOCALECONV_GROUPING
1127 if (lcbuf->grouping && *lcbuf->grouping)
1128 hv_store(RETVAL, "grouping", 8,
1129 newSVpv(lcbuf->grouping, 0), 0);
1131 if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
1132 hv_store(RETVAL, "int_curr_symbol", 15,
1133 newSVpv(lcbuf->int_curr_symbol, 0), 0);
1134 if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
1135 hv_store(RETVAL, "currency_symbol", 15,
1136 newSVpv(lcbuf->currency_symbol, 0), 0);
1137 if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
1138 hv_store(RETVAL, "mon_decimal_point", 17,
1139 newSVpv(lcbuf->mon_decimal_point, 0), 0);
1140 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
1141 if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
1142 hv_store(RETVAL, "mon_thousands_sep", 17,
1143 newSVpv(lcbuf->mon_thousands_sep, 0), 0);
1145 #ifndef NO_LOCALECONV_MON_GROUPING
1146 if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
1147 hv_store(RETVAL, "mon_grouping", 12,
1148 newSVpv(lcbuf->mon_grouping, 0), 0);
1150 if (lcbuf->positive_sign && *lcbuf->positive_sign)
1151 hv_store(RETVAL, "positive_sign", 13,
1152 newSVpv(lcbuf->positive_sign, 0), 0);
1153 if (lcbuf->negative_sign && *lcbuf->negative_sign)
1154 hv_store(RETVAL, "negative_sign", 13,
1155 newSVpv(lcbuf->negative_sign, 0), 0);
1157 if (lcbuf->int_frac_digits != CHAR_MAX)
1158 hv_store(RETVAL, "int_frac_digits", 15,
1159 newSViv(lcbuf->int_frac_digits), 0);
1160 if (lcbuf->frac_digits != CHAR_MAX)
1161 hv_store(RETVAL, "frac_digits", 11,
1162 newSViv(lcbuf->frac_digits), 0);
1163 if (lcbuf->p_cs_precedes != CHAR_MAX)
1164 hv_store(RETVAL, "p_cs_precedes", 13,
1165 newSViv(lcbuf->p_cs_precedes), 0);
1166 if (lcbuf->p_sep_by_space != CHAR_MAX)
1167 hv_store(RETVAL, "p_sep_by_space", 14,
1168 newSViv(lcbuf->p_sep_by_space), 0);
1169 if (lcbuf->n_cs_precedes != CHAR_MAX)
1170 hv_store(RETVAL, "n_cs_precedes", 13,
1171 newSViv(lcbuf->n_cs_precedes), 0);
1172 if (lcbuf->n_sep_by_space != CHAR_MAX)
1173 hv_store(RETVAL, "n_sep_by_space", 14,
1174 newSViv(lcbuf->n_sep_by_space), 0);
1175 if (lcbuf->p_sign_posn != CHAR_MAX)
1176 hv_store(RETVAL, "p_sign_posn", 11,
1177 newSViv(lcbuf->p_sign_posn), 0);
1178 if (lcbuf->n_sign_posn != CHAR_MAX)
1179 hv_store(RETVAL, "n_sign_posn", 11,
1180 newSViv(lcbuf->n_sign_posn), 0);
1183 localeconv(); /* A stub to call not_here(). */
1189 setlocale(category, locale = 0)
1195 retval = setlocale(category, locale);
1197 /* Save retval since subsequent setlocale() calls
1198 * may overwrite it. */
1199 RETVAL = savepv(retval);
1200 #ifdef USE_LOCALE_CTYPE
1201 if (category == LC_CTYPE
1203 || category == LC_ALL
1209 if (category == LC_ALL)
1210 newctype = setlocale(LC_CTYPE, NULL);
1214 new_ctype(newctype);
1216 #endif /* USE_LOCALE_CTYPE */
1217 #ifdef USE_LOCALE_COLLATE
1218 if (category == LC_COLLATE
1220 || category == LC_ALL
1226 if (category == LC_ALL)
1227 newcoll = setlocale(LC_COLLATE, NULL);
1231 new_collate(newcoll);
1233 #endif /* USE_LOCALE_COLLATE */
1234 #ifdef USE_LOCALE_NUMERIC
1235 if (category == LC_NUMERIC
1237 || category == LC_ALL
1243 if (category == LC_ALL)
1244 newnum = setlocale(LC_NUMERIC, NULL);
1248 new_numeric(newnum);
1250 #endif /* USE_LOCALE_NUMERIC */
1294 /* (We already know stack is long enough.) */
1295 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1296 PUSHs(sv_2mortal(newSViv(expvar)));
1312 /* (We already know stack is long enough.) */
1313 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1314 PUSHs(sv_2mortal(newSVnv(intvar)));
1329 sigaction(sig, optaction, oldaction = 0)
1332 POSIX::SigAction oldaction
1334 #if defined(WIN32) || defined(NETWARE)
1335 RETVAL = not_here("sigaction");
1337 # This code is really grody because we're trying to make the signal
1338 # interface look beautiful, which is hard.
1342 POSIX__SigAction action;
1343 GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
1344 struct sigaction act;
1345 struct sigaction oact;
1349 POSIX__SigSet sigset;
1354 croak("Negative signals are not allowed");
1357 if (sig == 0 && SvPOK(ST(0))) {
1358 const char *s = SvPVX_const(ST(0));
1359 int i = whichsig(s);
1361 if (i < 0 && memEQ(s, "SIG", 3))
1362 i = whichsig(s + 3);
1364 if (ckWARN(WARN_SIGNAL))
1365 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1366 "No such signal: SIG%s", s);
1373 if (sig > NSIG) { /* NSIG - 1 is still okay. */
1374 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1375 "No such signal: %d", sig);
1379 sigsvp = hv_fetch(GvHVn(siggv),
1381 strlen(PL_sig_name[sig]),
1384 /* Check optaction and set action */
1385 if(SvTRUE(optaction)) {
1386 if(sv_isa(optaction, "POSIX::SigAction"))
1387 action = (HV*)SvRV(optaction);
1389 croak("action is not of type POSIX::SigAction");
1395 /* sigaction() is supposed to look atomic. In particular, any
1396 * signal handler invoked during a sigaction() call should
1397 * see either the old or the new disposition, and not something
1398 * in between. We use sigprocmask() to make it so.
1401 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1405 /* Restore signal mask no matter how we exit this block. */
1406 osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
1407 SAVEFREESV( osset_sv );
1408 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1410 RETVAL=-1; /* In case both oldaction and action are 0. */
1412 /* Remember old disposition if desired. */
1414 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1416 croak("Can't supply an oldaction without a HANDLER");
1417 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1418 sv_setsv(*svp, *sigsvp);
1421 sv_setpvs(*svp, "DEFAULT");
1423 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1428 /* Get back the mask. */
1429 svp = hv_fetchs(oldaction, "MASK", TRUE);
1430 if (sv_isa(*svp, "POSIX::SigSet")) {
1431 IV tmp = SvIV((SV*)SvRV(*svp));
1432 sigset = INT2PTR(sigset_t*, tmp);
1435 Newx(sigset, 1, sigset_t);
1436 sv_setptrobj(*svp, sigset, "POSIX::SigSet");
1438 *sigset = oact.sa_mask;
1440 /* Get back the flags. */
1441 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1442 sv_setiv(*svp, oact.sa_flags);
1444 /* Get back whether the old handler used safe signals. */
1445 svp = hv_fetchs(oldaction, "SAFE", TRUE);
1447 /* compare incompatible pointers by casting to integer */
1448 PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
1452 /* Safe signals use "csighandler", which vectors through the
1453 PL_sighandlerp pointer when it's safe to do so.
1454 (BTW, "csighandler" is very different from "sighandler".) */
1455 svp = hv_fetchs(action, "SAFE", FALSE);
1459 (*svp && SvTRUE(*svp))
1460 ? PL_csighandlerp : PL_sighandlerp
1463 /* Vector new Perl handler through %SIG.
1464 (The core signal handlers read %SIG to dispatch.) */
1465 svp = hv_fetchs(action, "HANDLER", FALSE);
1467 croak("Can't supply an action without a HANDLER");
1468 sv_setsv(*sigsvp, *svp);
1470 /* This call actually calls sigaction() with almost the
1471 right settings, including appropriate interpretation
1472 of DEFAULT and IGNORE. However, why are we doing
1473 this when we're about to do it again just below? XXX */
1476 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1478 const char *s=SvPVX_const(*svp);
1479 if(strEQ(s,"IGNORE")) {
1480 act.sa_handler = SIG_IGN;
1482 else if(strEQ(s,"DEFAULT")) {
1483 act.sa_handler = SIG_DFL;
1487 /* Set up any desired mask. */
1488 svp = hv_fetchs(action, "MASK", FALSE);
1489 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1490 IV tmp = SvIV((SV*)SvRV(*svp));
1491 sigset = INT2PTR(sigset_t*, tmp);
1492 act.sa_mask = *sigset;
1495 sigemptyset(& act.sa_mask);
1497 /* Set up any desired flags. */
1498 svp = hv_fetchs(action, "FLAGS", FALSE);
1499 act.sa_flags = svp ? SvIV(*svp) : 0;
1501 /* Don't worry about cleaning up *sigsvp if this fails,
1502 * because that means we tried to disposition a
1503 * nonblockable signal, in which case *sigsvp is
1504 * essentially meaningless anyway.
1506 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1521 POSIX::SigSet sigset
1524 sigprocmask(how, sigset, oldsigset = 0)
1526 POSIX::SigSet sigset = NO_INIT
1527 POSIX::SigSet oldsigset = NO_INIT
1529 if (! SvOK(ST(1))) {
1531 } else if (sv_isa(ST(1), "POSIX::SigSet")) {
1532 IV tmp = SvIV((SV*)SvRV(ST(1)));
1533 sigset = INT2PTR(POSIX__SigSet,tmp);
1535 croak("sigset is not of type POSIX::SigSet");
1538 if (items < 3 || ! SvOK(ST(2))) {
1540 } else if (sv_isa(ST(2), "POSIX::SigSet")) {
1541 IV tmp = SvIV((SV*)SvRV(ST(2)));
1542 oldsigset = INT2PTR(POSIX__SigSet,tmp);
1544 croak("oldsigset is not of type POSIX::SigSet");
1548 sigsuspend(signal_mask)
1549 POSIX::SigSet signal_mask
1569 lseek(fd, offset, whence)
1574 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1575 RETVAL = sizeof(Off_t) > sizeof(IV)
1576 ? newSVnv((NV)pos) : newSViv((IV)pos);
1585 if ((incr = nice(incr)) != -1 || errno == 0) {
1587 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
1589 XPUSHs(sv_2mortal(newSViv(incr)));
1596 if (pipe(fds) != -1) {
1598 PUSHs(sv_2mortal(newSViv(fds[0])));
1599 PUSHs(sv_2mortal(newSViv(fds[1])));
1603 read(fd, buffer, nbytes)
1605 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1609 char * buffer = sv_grow( sv_buffer, nbytes+1 );
1612 SvCUR_set(sv_buffer, RETVAL);
1613 SvPOK_only(sv_buffer);
1614 *SvEND(sv_buffer) = '\0';
1615 SvTAINTED_on(sv_buffer);
1631 tcsetpgrp(fd, pgrp_id)
1640 if (uname(&buf) >= 0) {
1642 PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
1643 PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
1644 PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
1645 PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
1646 PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
1649 uname((char *) 0); /* A stub to call not_here(). */
1653 write(fd, buffer, nbytes)
1664 RETVAL = newSVpvn("", 0);
1665 SvGROW(RETVAL, L_tmpnam);
1666 len = strlen(tmpnam(SvPV(RETVAL, i)));
1667 SvCUR_set(RETVAL, len);
1680 mbstowcs(s, pwcs, n)
1692 wcstombs(s, pwcs, n)
1714 SET_NUMERIC_LOCAL();
1715 num = strtod(str, &unparsed);
1716 PUSHs(sv_2mortal(newSVnv(num)));
1717 if (GIMME == G_ARRAY) {
1720 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1722 PUSHs(&PL_sv_undef);
1726 strtol(str, base = 0)
1733 num = strtol(str, &unparsed, base);
1734 #if IVSIZE <= LONGSIZE
1735 if (num < IV_MIN || num > IV_MAX)
1736 PUSHs(sv_2mortal(newSVnv((double)num)));
1739 PUSHs(sv_2mortal(newSViv((IV)num)));
1740 if (GIMME == G_ARRAY) {
1743 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1745 PUSHs(&PL_sv_undef);
1749 strtoul(str, base = 0)
1756 num = strtoul(str, &unparsed, base);
1757 #if IVSIZE <= LONGSIZE
1759 PUSHs(sv_2mortal(newSVnv((double)num)));
1762 PUSHs(sv_2mortal(newSViv((IV)num)));
1763 if (GIMME == G_ARRAY) {
1766 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1768 PUSHs(&PL_sv_undef);
1778 char *p = SvPV(src,srclen);
1780 ST(0) = sv_2mortal(newSV(srclen*4+1));
1781 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1782 if (dstlen > srclen) {
1784 SvGROW(ST(0), dstlen);
1785 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1788 SvCUR_set(ST(0), dstlen);
1793 mkfifo(filename, mode)
1797 TAINT_PROPER("mkfifo");
1798 RETVAL = mkfifo(filename, mode);
1814 tcflush(fd, queue_selector)
1819 tcsendbreak(fd, duration)
1824 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1837 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1840 mytm.tm_hour = hour;
1841 mytm.tm_mday = mday;
1843 mytm.tm_year = year;
1844 mytm.tm_wday = wday;
1845 mytm.tm_yday = yday;
1846 mytm.tm_isdst = isdst;
1847 RETVAL = asctime(&mytm);
1864 realtime = times( &tms );
1866 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1867 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1868 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1869 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1870 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1873 difftime(time1, time2)
1878 mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1891 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1894 mytm.tm_hour = hour;
1895 mytm.tm_mday = mday;
1897 mytm.tm_year = year;
1898 mytm.tm_wday = wday;
1899 mytm.tm_yday = yday;
1900 mytm.tm_isdst = isdst;
1901 RETVAL = (SysRetLong) mktime(&mytm);
1906 #XXX: if $xsubpp::WantOptimize is always the default
1907 # sv_setpv(TARG, ...) could be used rather than
1908 # ST(0) = sv_2mortal(newSVpv(...))
1910 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1923 char *buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
1925 SV *const sv = sv_newmortal();
1926 sv_usepvn_flags(sv, buf, strlen(buf), SV_HAS_TRAILING_NUL);
1943 PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
1944 PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
1947 access(filename, mode)
1955 #ifdef HAS_CTERMID_R
1956 s = (char *) safemalloc((size_t) L_ctermid);
1958 RETVAL = ctermid(s);
1962 #ifdef HAS_CTERMID_R
1971 RETVAL = cuserid(s);
1974 not_here("cuserid");
1985 pathconf(filename, name)
1999 PL_egid = getegid();
2010 PL_euid = geteuid();
2028 XSprePUSH; PUSHTARG;
2032 lchown(uid, gid, path)
2038 /* yes, the order of arguments is different,
2039 * but consistent with CORE::chown() */
2040 RETVAL = lchown(path, uid, gid);
2042 RETVAL = not_here("lchown");