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