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)
66 #include <sys/types.h>
71 #ifdef MACOS_TRADITIONAL
77 # if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE)
78 extern char *tzname[];
81 #if !defined(WIN32) || (defined(__MINGW32__) && !defined(tzname))
82 char *tzname[] = { "" , "" };
86 #if defined(__VMS) && !defined(__POSIX_SOURCE)
87 # include <libdef.h> /* LIB$_INVARG constant */
88 # include <lib$routines.h> /* prototype for lib$ediv() */
89 # include <starlet.h> /* prototype for sys$gettim() */
90 # if DECC_VERSION < 50000000
91 # define pid_t int /* old versions of DECC miss this in types.h */
95 # define mkfifo(a,b) (not_here("mkfifo"),-1)
96 # define tzset() not_here("tzset")
98 #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
99 # define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */
100 # include <utsname.h>
101 # endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
103 /* The POSIX notion of ttyname() is better served by getname() under VMS */
104 static char ttnambuf[64];
105 # define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
107 /* The non-POSIX CRTL times() has void return type, so we just get the
108 current time directly */
109 clock_t vms_times(struct tms *bufptr) {
112 /* Get wall time and convert to 10 ms intervals to
113 * produce the return value that the POSIX standard expects */
114 # if defined(__DECC) && defined (__ALPHA)
117 _ckvmssts(sys$gettim(&vmstime));
119 retval = vmstime & 0x7fffffff;
121 /* (Older hw or ccs don't have an atomic 64-bit type, so we
122 * juggle 32-bit ints (and a float) to produce a time_t result
123 * with minimal loss of information.) */
124 long int vmstime[2],remainder,divisor = 100000;
125 _ckvmssts(sys$gettim((unsigned long int *)vmstime));
126 vmstime[1] &= 0x7fff; /* prevent overflow in EDIV */
127 _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
129 /* Fill in the struct tms using the CRTL routine . . .*/
130 times((tbuffer_t *)bufptr);
131 return (clock_t) retval;
133 # define times(t) vms_times(t)
135 #if defined (__CYGWIN__)
136 # define tzname _tzname
138 #if defined (WIN32) || defined (NETWARE)
140 # define mkfifo(a,b) not_here("mkfifo")
141 # define ttyname(a) (char*)not_here("ttyname")
142 # define sigset_t long
145 # define tzname _tzname
148 # define mode_t short
151 # define mode_t short
153 # define tzset() not_here("tzset")
155 # ifndef _POSIX_OPEN_MAX
156 # define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
159 # define sigaction(a,b,c) not_here("sigaction")
160 # define sigpending(a) not_here("sigpending")
161 # define sigprocmask(a,b,c) not_here("sigprocmask")
162 # define sigsuspend(a) not_here("sigsuspend")
163 # define sigemptyset(a) not_here("sigemptyset")
164 # define sigaddset(a,b) not_here("sigaddset")
165 # define sigdelset(a,b) not_here("sigdelset")
166 # define sigfillset(a) not_here("sigfillset")
167 # define sigismember(a,b) not_here("sigismember")
171 # define setuid(a) not_here("setuid")
172 # define setgid(a) not_here("setgid")
177 # if defined(OS2) || defined(MACOS_TRADITIONAL)
178 # define mkfifo(a,b) not_here("mkfifo")
179 # else /* !( defined OS2 ) */
181 # define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
184 # endif /* !HAS_MKFIFO */
186 # ifdef MACOS_TRADITIONAL
187 # define ttyname(a) (char*)not_here("ttyname")
188 # define tzset() not_here("tzset")
191 # include <sys/times.h>
193 # include <sys/utsname.h>
195 # include <sys/wait.h>
200 #endif /* WIN32 || NETWARE */
204 typedef long SysRetLong;
205 typedef sigset_t* POSIX__SigSet;
206 typedef HV* POSIX__SigAction;
208 typedef struct termios* POSIX__Termios;
209 #else /* Define termios types to int, and call not_here for the functions.*/
210 #define POSIX__Termios int
214 #define cfgetispeed(x) not_here("cfgetispeed")
215 #define cfgetospeed(x) not_here("cfgetospeed")
216 #define tcdrain(x) not_here("tcdrain")
217 #define tcflush(x,y) not_here("tcflush")
218 #define tcsendbreak(x,y) not_here("tcsendbreak")
219 #define cfsetispeed(x,y) not_here("cfsetispeed")
220 #define cfsetospeed(x,y) not_here("cfsetospeed")
221 #define ctermid(x) (char *) not_here("ctermid")
222 #define tcflow(x,y) not_here("tcflow")
223 #define tcgetattr(x,y) not_here("tcgetattr")
224 #define tcsetattr(x,y,z) not_here("tcsetattr")
227 /* Possibly needed prototypes */
228 char *cuserid (char *);
230 double strtod (const char *, char **);
231 long strtol (const char *, char **, int);
232 unsigned long strtoul (const char *, char **, int);
236 #define cuserid(a) (char *) not_here("cuserid")
240 #define difftime(a,b) not_here("difftime")
243 #ifndef HAS_FPATHCONF
244 #define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
247 #define mktime(a) not_here("mktime")
250 #define nice(a) not_here("nice")
253 #define pathconf(f,n) (SysRetLong) not_here("pathconf")
256 #define sysconf(n) (SysRetLong) not_here("sysconf")
259 #define readlink(a,b,c) not_here("readlink")
262 #define setpgid(a,b) not_here("setpgid")
265 #define setsid() not_here("setsid")
268 #define strcoll(s1,s2) not_here("strcoll")
271 #define strtod(s1,s2) not_here("strtod")
274 #define strtol(s1,s2,b) not_here("strtol")
277 #define strtoul(s1,s2,b) not_here("strtoul")
280 #define strxfrm(s1,s2,n) not_here("strxfrm")
282 #ifndef HAS_TCGETPGRP
283 #define tcgetpgrp(a) not_here("tcgetpgrp")
285 #ifndef HAS_TCSETPGRP
286 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
290 #define times(a) not_here("times")
294 #define uname(a) not_here("uname")
297 #define waitpid(a,b,c) not_here("waitpid")
302 #define mblen(a,b) not_here("mblen")
306 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
309 #define mbtowc(pwc, s, n) not_here("mbtowc")
312 #define wcstombs(s, pwcs, n) not_here("wcstombs")
315 #define wctomb(s, wchar) not_here("wcstombs")
317 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
318 /* If we don't have these functions, then we wouldn't have gotten a typedef
319 for wchar_t, the wide character type. Defining wchar_t allows the
320 functions referencing it to compile. Its actual type is then meaningless,
321 since without the above functions, all sections using it end up calling
322 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
328 #ifndef HAS_LOCALECONV
329 #define localeconv() not_here("localeconv")
332 #ifdef HAS_LONG_DOUBLE
333 # if LONG_DOUBLESIZE > NVSIZE
334 # undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
338 #ifndef HAS_LONG_DOUBLE
350 /* Background: in most systems the low byte of the wait status
351 * is the signal (the lowest 7 bits) and the coredump flag is
352 * the eight bit, and the second lowest byte is the exit status.
353 * BeOS bucks the trend and has the bytes in different order.
354 * See beos/beos.c for how the reality is bent even in BeOS
355 * to follow the traditional. However, to make the POSIX
356 * wait W*() macros to work in BeOS, we need to unbend the
357 * reality back in place. --jhi */
359 # define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
361 # define WMUNGE(x) (x)
367 croak("POSIX::%s not implemented on this architecture", s);
371 #include "const-c.inc"
373 /* These were implemented in the old "constant" subroutine. They are actually
374 macros that take an integer argument and return an integer result. */
376 int_macro_int (const char *name, STRLEN len, IV *arg_result) {
377 /* Initially switch on the length of the name. */
378 /* This code has been edited from a "constant" function generated by:
380 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
382 my $types = {map {($_, 1)} qw(IV)};
383 my @names = (qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS WIFEXITED
384 WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
386 print constant_types(); # macro defs
387 foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) {
388 print $_, "\n"; # C constant subs
390 print "#### XS Section:\n";
391 print XS_constant ("POSIX", $types);
397 /* Names all of length 7. */
398 /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */
399 /* Offset 5 gives the best switch position. */
402 if (memEQ(name, "S_ISREG", 7)) {
405 *arg_result = S_ISREG(*arg_result);
406 return PERL_constant_ISIV;
408 return PERL_constant_NOTDEF;
413 if (memEQ(name, "S_ISCHR", 7)) {
416 *arg_result = S_ISCHR(*arg_result);
417 return PERL_constant_ISIV;
419 return PERL_constant_NOTDEF;
424 if (memEQ(name, "S_ISDIR", 7)) {
427 *arg_result = S_ISDIR(*arg_result);
428 return PERL_constant_ISIV;
430 return PERL_constant_NOTDEF;
435 if (memEQ(name, "S_ISBLK", 7)) {
438 *arg_result = S_ISBLK(*arg_result);
439 return PERL_constant_ISIV;
441 return PERL_constant_NOTDEF;
448 /* Names all of length 8. */
449 /* S_ISFIFO WSTOPSIG WTERMSIG */
450 /* Offset 3 gives the best switch position. */
453 if (memEQ(name, "WSTOPSIG", 8)) {
457 *arg_result = WSTOPSIG(WMUNGE(i));
458 return PERL_constant_ISIV;
460 return PERL_constant_NOTDEF;
465 if (memEQ(name, "WTERMSIG", 8)) {
469 *arg_result = WTERMSIG(WMUNGE(i));
470 return PERL_constant_ISIV;
472 return PERL_constant_NOTDEF;
477 if (memEQ(name, "S_ISFIFO", 8)) {
480 *arg_result = S_ISFIFO(*arg_result);
481 return PERL_constant_ISIV;
483 return PERL_constant_NOTDEF;
490 if (memEQ(name, "WIFEXITED", 9)) {
493 *arg_result = WIFEXITED(WMUNGE(i));
494 return PERL_constant_ISIV;
496 return PERL_constant_NOTDEF;
501 if (memEQ(name, "WIFSTOPPED", 10)) {
504 *arg_result = WIFSTOPPED(WMUNGE(i));
505 return PERL_constant_ISIV;
507 return PERL_constant_NOTDEF;
512 /* Names all of length 11. */
513 /* WEXITSTATUS WIFSIGNALED */
514 /* Offset 1 gives the best switch position. */
517 if (memEQ(name, "WEXITSTATUS", 11)) {
521 *arg_result = WEXITSTATUS(WMUNGE(i));
522 return PERL_constant_ISIV;
524 return PERL_constant_NOTDEF;
529 if (memEQ(name, "WIFSIGNALED", 11)) {
533 *arg_result = WIFSIGNALED(WMUNGE(i));
534 return PERL_constant_ISIV;
536 return PERL_constant_NOTDEF;
543 return PERL_constant_NOTFOUND;
547 restore_sigmask(pTHX_ SV *osset_sv)
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
554 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
555 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
558 MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
561 new(packname = "POSIX::SigSet", ...)
566 New(0, RETVAL, 1, sigset_t);
568 for (i = 1; i < items; i++)
569 sigaddset(RETVAL, SvIV(ST(i)));
581 sigaddset(sigset, sig)
586 sigdelset(sigset, sig)
599 sigismember(sigset, sig)
604 MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
607 new(packname = "POSIX::Termios", ...)
612 New(0, RETVAL, 1, struct termios);
623 POSIX::Termios termios_ref
626 Safefree(termios_ref);
632 getattr(termios_ref, fd = 0)
633 POSIX::Termios termios_ref
636 RETVAL = tcgetattr(fd, termios_ref);
641 setattr(termios_ref, fd = 0, optional_actions = 0)
642 POSIX::Termios termios_ref
646 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
651 cfgetispeed(termios_ref)
652 POSIX::Termios termios_ref
655 cfgetospeed(termios_ref)
656 POSIX::Termios termios_ref
659 getiflag(termios_ref)
660 POSIX::Termios termios_ref
662 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
663 RETVAL = termios_ref->c_iflag;
665 not_here("getiflag");
672 getoflag(termios_ref)
673 POSIX::Termios termios_ref
675 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
676 RETVAL = termios_ref->c_oflag;
678 not_here("getoflag");
685 getcflag(termios_ref)
686 POSIX::Termios termios_ref
688 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
689 RETVAL = termios_ref->c_cflag;
691 not_here("getcflag");
698 getlflag(termios_ref)
699 POSIX::Termios termios_ref
701 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
702 RETVAL = termios_ref->c_lflag;
704 not_here("getlflag");
711 getcc(termios_ref, ccix)
712 POSIX::Termios termios_ref
715 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
717 croak("Bad getcc subscript");
718 RETVAL = termios_ref->c_cc[ccix];
727 cfsetispeed(termios_ref, speed)
728 POSIX::Termios termios_ref
732 cfsetospeed(termios_ref, speed)
733 POSIX::Termios termios_ref
737 setiflag(termios_ref, iflag)
738 POSIX::Termios termios_ref
741 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
742 termios_ref->c_iflag = iflag;
744 not_here("setiflag");
748 setoflag(termios_ref, oflag)
749 POSIX::Termios termios_ref
752 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
753 termios_ref->c_oflag = oflag;
755 not_here("setoflag");
759 setcflag(termios_ref, cflag)
760 POSIX::Termios termios_ref
763 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
764 termios_ref->c_cflag = cflag;
766 not_here("setcflag");
770 setlflag(termios_ref, lflag)
771 POSIX::Termios termios_ref
774 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
775 termios_ref->c_lflag = lflag;
777 not_here("setlflag");
781 setcc(termios_ref, ccix, cc)
782 POSIX::Termios termios_ref
786 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
788 croak("Bad setcc subscript");
789 termios_ref->c_cc[ccix] = cc;
795 MODULE = POSIX PACKAGE = POSIX
797 INCLUDE: const-xs.inc
800 int_macro_int(sv, iv)
807 const char * s = SvPV(sv, len);
810 /* Change this to int_macro_int(s, len, &iv, &nv);
811 if you need to return both NVs and IVs */
812 type = int_macro_int(s, len, &iv);
813 /* Return 1 or 2 items. First is error message, or undef if no error.
814 Second, if present, is found value */
816 case PERL_constant_NOTFOUND:
817 sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s));
822 case PERL_constant_NOTDEF:
823 sv = sv_2mortal(newSVpvf(
824 "Your vendor has not defined POSIX macro %s, used", s));
829 case PERL_constant_ISIV:
833 sv = sv_2mortal(newSVpvf(
834 "Unexpected return type %d while processing POSIX macro %s, used",
843 unsigned char * charstring
845 unsigned char *s = charstring;
846 unsigned char *e = s + SvCUR(ST(0));
847 for (RETVAL = 1; RETVAL && s < e; s++)
855 unsigned char * charstring
857 unsigned char *s = charstring;
858 unsigned char *e = s + SvCUR(ST(0));
859 for (RETVAL = 1; RETVAL && s < e; s++)
867 unsigned char * charstring
869 unsigned char *s = charstring;
870 unsigned char *e = s + SvCUR(ST(0));
871 for (RETVAL = 1; RETVAL && s < e; s++)
879 unsigned char * charstring
881 unsigned char *s = charstring;
882 unsigned char *e = s + SvCUR(ST(0));
883 for (RETVAL = 1; RETVAL && s < e; s++)
891 unsigned char * charstring
893 unsigned char *s = charstring;
894 unsigned char *e = s + SvCUR(ST(0));
895 for (RETVAL = 1; RETVAL && s < e; s++)
903 unsigned char * charstring
905 unsigned char *s = charstring;
906 unsigned char *e = s + SvCUR(ST(0));
907 for (RETVAL = 1; RETVAL && s < e; s++)
915 unsigned char * charstring
917 unsigned char *s = charstring;
918 unsigned char *e = s + SvCUR(ST(0));
919 for (RETVAL = 1; RETVAL && s < e; s++)
927 unsigned char * charstring
929 unsigned char *s = charstring;
930 unsigned char *e = s + SvCUR(ST(0));
931 for (RETVAL = 1; RETVAL && s < e; s++)
939 unsigned char * charstring
941 unsigned char *s = charstring;
942 unsigned char *e = s + SvCUR(ST(0));
943 for (RETVAL = 1; RETVAL && s < e; s++)
951 unsigned char * charstring
953 unsigned char *s = charstring;
954 unsigned char *e = s + SvCUR(ST(0));
955 for (RETVAL = 1; RETVAL && s < e; s++)
963 unsigned char * charstring
965 unsigned char *s = charstring;
966 unsigned char *e = s + SvCUR(ST(0));
967 for (RETVAL = 1; RETVAL && s < e; s++)
974 open(filename, flags = O_RDONLY, mode = 0666)
979 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
980 TAINT_PROPER("open");
981 RETVAL = open(filename, flags, mode);
989 #ifdef HAS_LOCALECONV
992 if ((lcbuf = localeconv())) {
994 if (lcbuf->decimal_point && *lcbuf->decimal_point)
995 hv_store(RETVAL, "decimal_point", 13,
996 newSVpv(lcbuf->decimal_point, 0), 0);
997 if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
998 hv_store(RETVAL, "thousands_sep", 13,
999 newSVpv(lcbuf->thousands_sep, 0), 0);
1000 #ifndef NO_LOCALECONV_GROUPING
1001 if (lcbuf->grouping && *lcbuf->grouping)
1002 hv_store(RETVAL, "grouping", 8,
1003 newSVpv(lcbuf->grouping, 0), 0);
1005 if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
1006 hv_store(RETVAL, "int_curr_symbol", 15,
1007 newSVpv(lcbuf->int_curr_symbol, 0), 0);
1008 if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
1009 hv_store(RETVAL, "currency_symbol", 15,
1010 newSVpv(lcbuf->currency_symbol, 0), 0);
1011 if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
1012 hv_store(RETVAL, "mon_decimal_point", 17,
1013 newSVpv(lcbuf->mon_decimal_point, 0), 0);
1014 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
1015 if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
1016 hv_store(RETVAL, "mon_thousands_sep", 17,
1017 newSVpv(lcbuf->mon_thousands_sep, 0), 0);
1019 #ifndef NO_LOCALECONV_MON_GROUPING
1020 if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
1021 hv_store(RETVAL, "mon_grouping", 12,
1022 newSVpv(lcbuf->mon_grouping, 0), 0);
1024 if (lcbuf->positive_sign && *lcbuf->positive_sign)
1025 hv_store(RETVAL, "positive_sign", 13,
1026 newSVpv(lcbuf->positive_sign, 0), 0);
1027 if (lcbuf->negative_sign && *lcbuf->negative_sign)
1028 hv_store(RETVAL, "negative_sign", 13,
1029 newSVpv(lcbuf->negative_sign, 0), 0);
1031 if (lcbuf->int_frac_digits != CHAR_MAX)
1032 hv_store(RETVAL, "int_frac_digits", 15,
1033 newSViv(lcbuf->int_frac_digits), 0);
1034 if (lcbuf->frac_digits != CHAR_MAX)
1035 hv_store(RETVAL, "frac_digits", 11,
1036 newSViv(lcbuf->frac_digits), 0);
1037 if (lcbuf->p_cs_precedes != CHAR_MAX)
1038 hv_store(RETVAL, "p_cs_precedes", 13,
1039 newSViv(lcbuf->p_cs_precedes), 0);
1040 if (lcbuf->p_sep_by_space != CHAR_MAX)
1041 hv_store(RETVAL, "p_sep_by_space", 14,
1042 newSViv(lcbuf->p_sep_by_space), 0);
1043 if (lcbuf->n_cs_precedes != CHAR_MAX)
1044 hv_store(RETVAL, "n_cs_precedes", 13,
1045 newSViv(lcbuf->n_cs_precedes), 0);
1046 if (lcbuf->n_sep_by_space != CHAR_MAX)
1047 hv_store(RETVAL, "n_sep_by_space", 14,
1048 newSViv(lcbuf->n_sep_by_space), 0);
1049 if (lcbuf->p_sign_posn != CHAR_MAX)
1050 hv_store(RETVAL, "p_sign_posn", 11,
1051 newSViv(lcbuf->p_sign_posn), 0);
1052 if (lcbuf->n_sign_posn != CHAR_MAX)
1053 hv_store(RETVAL, "n_sign_posn", 11,
1054 newSViv(lcbuf->n_sign_posn), 0);
1057 localeconv(); /* A stub to call not_here(). */
1063 setlocale(category, locale = 0)
1067 RETVAL = setlocale(category, locale);
1069 #ifdef USE_LOCALE_CTYPE
1070 if (category == LC_CTYPE
1072 || category == LC_ALL
1078 if (category == LC_ALL)
1079 newctype = setlocale(LC_CTYPE, NULL);
1083 new_ctype(newctype);
1085 #endif /* USE_LOCALE_CTYPE */
1086 #ifdef USE_LOCALE_COLLATE
1087 if (category == LC_COLLATE
1089 || category == LC_ALL
1095 if (category == LC_ALL)
1096 newcoll = setlocale(LC_COLLATE, NULL);
1100 new_collate(newcoll);
1102 #endif /* USE_LOCALE_COLLATE */
1103 #ifdef USE_LOCALE_NUMERIC
1104 if (category == LC_NUMERIC
1106 || category == LC_ALL
1112 if (category == LC_ALL)
1113 newnum = setlocale(LC_NUMERIC, NULL);
1117 new_numeric(newnum);
1119 #endif /* USE_LOCALE_NUMERIC */
1159 /* (We already know stack is long enough.) */
1160 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1161 PUSHs(sv_2mortal(newSViv(expvar)));
1177 /* (We already know stack is long enough.) */
1178 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1179 PUSHs(sv_2mortal(newSVnv(intvar)));
1194 sigaction(sig, optaction, oldaction = 0)
1197 POSIX::SigAction oldaction
1199 #if defined(WIN32) || defined(NETWARE)
1200 RETVAL = not_here("sigaction");
1202 # This code is really grody because we're trying to make the signal
1203 # interface look beautiful, which is hard.
1206 POSIX__SigAction action;
1207 GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
1208 struct sigaction act;
1209 struct sigaction oact;
1213 POSIX__SigSet sigset;
1215 SV** sigsvp = hv_fetch(GvHVn(siggv),
1217 strlen(PL_sig_name[sig]),
1220 /* Check optaction and set action */
1221 if(SvTRUE(optaction)) {
1222 if(sv_isa(optaction, "POSIX::SigAction"))
1223 action = (HV*)SvRV(optaction);
1225 croak("action is not of type POSIX::SigAction");
1231 /* sigaction() is supposed to look atomic. In particular, any
1232 * signal handler invoked during a sigaction() call should
1233 * see either the old or the new disposition, and not something
1234 * in between. We use sigprocmask() to make it so.
1237 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1241 /* Restore signal mask no matter how we exit this block. */
1242 osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));
1243 SAVEFREESV( osset_sv );
1244 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1246 RETVAL=-1; /* In case both oldaction and action are 0. */
1248 /* Remember old disposition if desired. */
1250 svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
1252 croak("Can't supply an oldaction without a HANDLER");
1253 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1254 sv_setsv(*svp, *sigsvp);
1257 sv_setpv(*svp, "DEFAULT");
1259 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1262 /* Get back the mask. */
1263 svp = hv_fetch(oldaction, "MASK", 4, TRUE);
1264 if (sv_isa(*svp, "POSIX::SigSet")) {
1265 IV tmp = SvIV((SV*)SvRV(*svp));
1266 sigset = INT2PTR(sigset_t*, tmp);
1269 New(0, sigset, 1, sigset_t);
1270 sv_setptrobj(*svp, sigset, "POSIX::SigSet");
1272 *sigset = oact.sa_mask;
1274 /* Get back the flags. */
1275 svp = hv_fetch(oldaction, "FLAGS", 5, TRUE);
1276 sv_setiv(*svp, oact.sa_flags);
1280 /* Vector new handler through %SIG. (We always use sighandler
1281 for the C signal handler, which reads %SIG to dispatch.) */
1282 svp = hv_fetch(action, "HANDLER", 7, FALSE);
1284 croak("Can't supply an action without a HANDLER");
1285 sv_setsv(*sigsvp, *svp);
1286 mg_set(*sigsvp); /* handles DEFAULT and IGNORE */
1288 char *s=SvPVX(*svp);
1289 if(strEQ(s,"IGNORE")) {
1290 act.sa_handler = SIG_IGN;
1292 else if(strEQ(s,"DEFAULT")) {
1293 act.sa_handler = SIG_DFL;
1296 act.sa_handler = PL_sighandlerp;
1300 act.sa_handler = PL_sighandlerp;
1303 /* Set up any desired mask. */
1304 svp = hv_fetch(action, "MASK", 4, FALSE);
1305 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1306 IV tmp = SvIV((SV*)SvRV(*svp));
1307 sigset = INT2PTR(sigset_t*, tmp);
1308 act.sa_mask = *sigset;
1311 sigemptyset(& act.sa_mask);
1313 /* Set up any desired flags. */
1314 svp = hv_fetch(action, "FLAGS", 5, FALSE);
1315 act.sa_flags = svp ? SvIV(*svp) : 0;
1317 /* Don't worry about cleaning up *sigsvp if this fails,
1318 * because that means we tried to disposition a
1319 * nonblockable signal, in which case *sigsvp is
1320 * essentially meaningless anyway.
1322 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1335 POSIX::SigSet sigset
1338 sigprocmask(how, sigset, oldsigset = 0)
1340 POSIX::SigSet sigset
1341 POSIX::SigSet oldsigset = NO_INIT
1346 else if (sv_derived_from(ST(2), "POSIX::SigSet")) {
1347 IV tmp = SvIV((SV*)SvRV(ST(2)));
1348 oldsigset = INT2PTR(POSIX__SigSet,tmp);
1351 New(0, oldsigset, 1, sigset_t);
1352 sigemptyset(oldsigset);
1353 sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset);
1357 sigsuspend(signal_mask)
1358 POSIX::SigSet signal_mask
1378 lseek(fd, offset, whence)
1383 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1384 RETVAL = sizeof(Off_t) > sizeof(IV)
1385 ? newSVnv((NV)pos) : newSViv((IV)pos);
1397 if (pipe(fds) != -1) {
1399 PUSHs(sv_2mortal(newSViv(fds[0])));
1400 PUSHs(sv_2mortal(newSViv(fds[1])));
1404 read(fd, buffer, nbytes)
1406 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1410 char * buffer = sv_grow( sv_buffer, nbytes+1 );
1413 SvCUR(sv_buffer) = RETVAL;
1414 SvPOK_only(sv_buffer);
1415 *SvEND(sv_buffer) = '\0';
1416 SvTAINTED_on(sv_buffer);
1432 tcsetpgrp(fd, pgrp_id)
1441 if (uname(&buf) >= 0) {
1443 PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
1444 PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
1445 PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
1446 PUSHs(sv_2mortal(newSVpv(buf.version, 0)));
1447 PUSHs(sv_2mortal(newSVpv(buf.machine, 0)));
1450 uname((char *) 0); /* A stub to call not_here(). */
1454 write(fd, buffer, nbytes)
1465 RETVAL = newSVpvn("", 0);
1466 SvGROW(RETVAL, L_tmpnam);
1467 len = strlen(tmpnam(SvPV(RETVAL, i)));
1468 SvCUR_set(RETVAL, len);
1481 mbstowcs(s, pwcs, n)
1493 wcstombs(s, pwcs, n)
1515 SET_NUMERIC_LOCAL();
1516 num = strtod(str, &unparsed);
1517 PUSHs(sv_2mortal(newSVnv(num)));
1518 if (GIMME == G_ARRAY) {
1521 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1523 PUSHs(&PL_sv_undef);
1527 strtol(str, base = 0)
1534 num = strtol(str, &unparsed, base);
1535 #if IVSIZE <= LONGSIZE
1536 if (num < IV_MIN || num > IV_MAX)
1537 PUSHs(sv_2mortal(newSVnv((double)num)));
1540 PUSHs(sv_2mortal(newSViv((IV)num)));
1541 if (GIMME == G_ARRAY) {
1544 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1546 PUSHs(&PL_sv_undef);
1550 strtoul(str, base = 0)
1557 num = strtoul(str, &unparsed, base);
1559 PUSHs(sv_2mortal(newSViv((IV)num)));
1561 PUSHs(sv_2mortal(newSVnv((double)num)));
1562 if (GIMME == G_ARRAY) {
1565 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1567 PUSHs(&PL_sv_undef);
1577 char *p = SvPV(src,srclen);
1579 ST(0) = sv_2mortal(NEWSV(800,srclen*4+1));
1580 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1581 if (dstlen > srclen) {
1583 SvGROW(ST(0), dstlen);
1584 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1587 SvCUR(ST(0)) = dstlen;
1592 mkfifo(filename, mode)
1596 TAINT_PROPER("mkfifo");
1597 RETVAL = mkfifo(filename, mode);
1613 tcflush(fd, queue_selector)
1618 tcsendbreak(fd, duration)
1623 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
1636 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1639 mytm.tm_hour = hour;
1640 mytm.tm_mday = mday;
1642 mytm.tm_year = year;
1643 mytm.tm_wday = wday;
1644 mytm.tm_yday = yday;
1645 mytm.tm_isdst = isdst;
1646 RETVAL = asctime(&mytm);
1663 realtime = times( &tms );
1665 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1666 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1667 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1668 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1669 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1672 difftime(time1, time2)
1677 mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
1690 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1693 mytm.tm_hour = hour;
1694 mytm.tm_mday = mday;
1696 mytm.tm_year = year;
1697 mytm.tm_wday = wday;
1698 mytm.tm_yday = yday;
1699 mytm.tm_isdst = isdst;
1700 RETVAL = mktime(&mytm);
1705 #XXX: if $xsubpp::WantOptimize is always the default
1706 # sv_setpv(TARG, ...) could be used rather than
1707 # ST(0) = sv_2mortal(newSVpv(...))
1709 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1722 char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
1724 ST(0) = sv_2mortal(newSVpv(buf, 0));
1736 PUSHs(sv_2mortal(newSVpvn(tzname[0],strlen(tzname[0]))));
1737 PUSHs(sv_2mortal(newSVpvn(tzname[1],strlen(tzname[1]))));
1740 access(filename, mode)
1758 pathconf(filename, name)
1787 XSprePUSH; PUSHTARG;