#include <unistd.h>
#endif
-/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
+/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
metaconfig for future extension writers. We don't use them in POSIX.
(This is really sneaky :-) --AD
*/
#ifdef I_STDLIB
#include <stdlib.h>
#endif
+#ifndef __ultrix__
#include <string.h>
+#endif
#include <sys/stat.h>
#include <sys/types.h>
#include <time.h>
#ifdef I_UNISTD
#include <unistd.h>
#endif
-#ifdef MACOS_TRADITIONAL
-#undef fdopen
-#endif
#include <fcntl.h>
#ifdef HAS_TZNAME
-# if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE)
+# if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
extern char *tzname[];
# endif
#else
-#if !defined(WIN32) || (defined(__MINGW32__) && !defined(tzname))
+#if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
char *tzname[] = { "" , "" };
#endif
#endif
# define ttyname(a) (char*)not_here("ttyname")
# define sigset_t long
# define pid_t long
-# ifdef __BORLANDC__
-# define tzname _tzname
-# endif
# ifdef _MSC_VER
# define mode_t short
# endif
#else
# ifndef HAS_MKFIFO
-# if defined(OS2) || defined(MACOS_TRADITIONAL)
+# if defined(OS2)
# define mkfifo(a,b) not_here("mkfifo")
-# else /* !( defined OS2 ) */
+# else /* !( defined OS2 ) */
# ifndef mkfifo
# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
# endif
# endif
# endif /* !HAS_MKFIFO */
-# ifdef MACOS_TRADITIONAL
-# define ttyname(a) (char*)not_here("ttyname")
-# define tzset() not_here("tzset")
-# else
+# ifdef I_GRP
# include <grp.h>
-# include <sys/times.h>
-# ifdef HAS_UNAME
-# include <sys/utsname.h>
-# endif
-# include <sys/wait.h>
# endif
+# include <sys/times.h>
+# ifdef HAS_UNAME
+# include <sys/utsname.h>
+# endif
+# include <sys/wait.h>
# ifdef I_UTIME
# include <utime.h>
# endif
#endif /* WIN32 || NETWARE */
#endif /* __VMS */
+#ifdef WIN32
+ /* Perl on Windows assigns WSAGetLastError() return values to errno
+ * (in win32/win32sck.c). Therefore we need to map these values
+ * back to standard symbolic names, but only for those names having
+ * no existing value or an existing value >= 100. (VC++ 2010 defines
+ * a group of names with values >= 100 in its errno.h which we *do*
+ * need to redefine.) The Errno.pm module does a similar mapping.
+ */
+# ifdef EWOULDBLOCK
+# undef EWOULDBLOCK
+# endif
+# define EWOULDBLOCK WSAEWOULDBLOCK
+# ifdef EINPROGRESS
+# undef EINPROGRESS
+# endif
+# define EINPROGRESS WSAEINPROGRESS
+# ifdef EALREADY
+# undef EALREADY
+# endif
+# define EALREADY WSAEALREADY
+# ifdef ENOTSOCK
+# undef ENOTSOCK
+# endif
+# define ENOTSOCK WSAENOTSOCK
+# ifdef EDESTADDRREQ
+# undef EDESTADDRREQ
+# endif
+# define EDESTADDRREQ WSAEDESTADDRREQ
+# ifdef EMSGSIZE
+# undef EMSGSIZE
+# endif
+# define EMSGSIZE WSAEMSGSIZE
+# ifdef EPROTOTYPE
+# undef EPROTOTYPE
+# endif
+# define EPROTOTYPE WSAEPROTOTYPE
+# ifdef ENOPROTOOPT
+# undef ENOPROTOOPT
+# endif
+# define ENOPROTOOPT WSAENOPROTOOPT
+# ifdef EPROTONOSUPPORT
+# undef EPROTONOSUPPORT
+# endif
+# define EPROTONOSUPPORT WSAEPROTONOSUPPORT
+# ifdef ESOCKTNOSUPPORT
+# undef ESOCKTNOSUPPORT
+# endif
+# define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
+# ifdef EOPNOTSUPP
+# undef EOPNOTSUPP
+# endif
+# define EOPNOTSUPP WSAEOPNOTSUPP
+# ifdef EPFNOSUPPORT
+# undef EPFNOSUPPORT
+# endif
+# define EPFNOSUPPORT WSAEPFNOSUPPORT
+# ifdef EAFNOSUPPORT
+# undef EAFNOSUPPORT
+# endif
+# define EAFNOSUPPORT WSAEAFNOSUPPORT
+# ifdef EADDRINUSE
+# undef EADDRINUSE
+# endif
+# define EADDRINUSE WSAEADDRINUSE
+# ifdef EADDRNOTAVAIL
+# undef EADDRNOTAVAIL
+# endif
+# define EADDRNOTAVAIL WSAEADDRNOTAVAIL
+# ifdef ENETDOWN
+# undef ENETDOWN
+# endif
+# define ENETDOWN WSAENETDOWN
+# ifdef ENETUNREACH
+# undef ENETUNREACH
+# endif
+# define ENETUNREACH WSAENETUNREACH
+# ifdef ENETRESET
+# undef ENETRESET
+# endif
+# define ENETRESET WSAENETRESET
+# ifdef ECONNABORTED
+# undef ECONNABORTED
+# endif
+# define ECONNABORTED WSAECONNABORTED
+# ifdef ECONNRESET
+# undef ECONNRESET
+# endif
+# define ECONNRESET WSAECONNRESET
+# ifdef ENOBUFS
+# undef ENOBUFS
+# endif
+# define ENOBUFS WSAENOBUFS
+# ifdef EISCONN
+# undef EISCONN
+# endif
+# define EISCONN WSAEISCONN
+# ifdef ENOTCONN
+# undef ENOTCONN
+# endif
+# define ENOTCONN WSAENOTCONN
+# ifdef ESHUTDOWN
+# undef ESHUTDOWN
+# endif
+# define ESHUTDOWN WSAESHUTDOWN
+# ifdef ETOOMANYREFS
+# undef ETOOMANYREFS
+# endif
+# define ETOOMANYREFS WSAETOOMANYREFS
+# ifdef ETIMEDOUT
+# undef ETIMEDOUT
+# endif
+# define ETIMEDOUT WSAETIMEDOUT
+# ifdef ECONNREFUSED
+# undef ECONNREFUSED
+# endif
+# define ECONNREFUSED WSAECONNREFUSED
+# ifdef ELOOP
+# undef ELOOP
+# endif
+# define ELOOP WSAELOOP
+# ifdef EHOSTDOWN
+# undef EHOSTDOWN
+# endif
+# define EHOSTDOWN WSAEHOSTDOWN
+# ifdef EHOSTUNREACH
+# undef EHOSTUNREACH
+# endif
+# define EHOSTUNREACH WSAEHOSTUNREACH
+# ifdef EPROCLIM
+# undef EPROCLIM
+# endif
+# define EPROCLIM WSAEPROCLIM
+# ifdef EUSERS
+# undef EUSERS
+# endif
+# define EUSERS WSAEUSERS
+# ifdef EDQUOT
+# undef EDQUOT
+# endif
+# define EDQUOT WSAEDQUOT
+# ifdef ESTALE
+# undef ESTALE
+# endif
+# define ESTALE WSAESTALE
+# ifdef EREMOTE
+# undef EREMOTE
+# endif
+# define EREMOTE WSAEREMOTE
+# ifdef EDISCON
+# undef EDISCON
+# endif
+# define EDISCON WSAEDISCON
+#endif
+
typedef int SysRet;
typedef long SysRetLong;
typedef sigset_t* POSIX__SigSet;
#endif
/* Possibly needed prototypes */
-char *cuserid (char *);
#ifndef WIN32
double strtod (const char *, char **);
long strtol (const char *, char **, int);
unsigned long strtoul (const char *, char **, int);
#endif
-#ifndef HAS_CUSERID
-#define cuserid(a) (char *) not_here("cuserid")
-#endif
#ifndef HAS_DIFFTIME
#ifndef difftime
#define difftime(a,b) not_here("difftime")
#endif
#endif
#ifndef HAS_FPATHCONF
-#define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
+#define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
#endif
#ifndef HAS_MKTIME
#define mktime(a) not_here("mktime")
#define nice(a) not_here("nice")
#endif
#ifndef HAS_PATHCONF
-#define pathconf(f,n) (SysRetLong) not_here("pathconf")
+#define pathconf(f,n) (SysRetLong) not_here("pathconf")
#endif
#ifndef HAS_SYSCONF
-#define sysconf(n) (SysRetLong) not_here("sysconf")
+#define sysconf(n) (SysRetLong) not_here("sysconf")
#endif
#ifndef HAS_READLINK
#define readlink(a,b,c) not_here("readlink")
#endif
#endif
-#ifndef HAS_LOCALECONV
+#ifdef HAS_LOCALECONV
+struct lconv_offset {
+ const char *name;
+ size_t offset;
+};
+
+const struct lconv_offset lconv_strings[] = {
+ {"decimal_point", offsetof(struct lconv, decimal_point)},
+ {"thousands_sep", offsetof(struct lconv, thousands_sep)},
+#ifndef NO_LOCALECONV_GROUPING
+ {"grouping", offsetof(struct lconv, grouping)},
+#endif
+ {"int_curr_symbol", offsetof(struct lconv, int_curr_symbol)},
+ {"currency_symbol", offsetof(struct lconv, currency_symbol)},
+ {"mon_decimal_point", offsetof(struct lconv, mon_decimal_point)},
+#ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
+ {"mon_thousands_sep", offsetof(struct lconv, mon_thousands_sep)},
+#endif
+#ifndef NO_LOCALECONV_MON_GROUPING
+ {"mon_grouping", offsetof(struct lconv, mon_grouping)},
+#endif
+ {"positive_sign", offsetof(struct lconv, positive_sign)},
+ {"negative_sign", offsetof(struct lconv, negative_sign)},
+ {NULL, 0}
+};
+
+const struct lconv_offset lconv_integers[] = {
+ {"int_frac_digits", offsetof(struct lconv, int_frac_digits)},
+ {"frac_digits", offsetof(struct lconv, frac_digits)},
+ {"p_cs_precedes", offsetof(struct lconv, p_cs_precedes)},
+ {"p_sep_by_space", offsetof(struct lconv, p_sep_by_space)},
+ {"n_cs_precedes", offsetof(struct lconv, n_cs_precedes)},
+ {"n_sep_by_space", offsetof(struct lconv, n_sep_by_space)},
+ {"p_sign_posn", offsetof(struct lconv, p_sign_posn)},
+ {"n_sign_posn", offsetof(struct lconv, n_sign_posn)},
+ {NULL, 0}
+};
+
+#else
#define localeconv() not_here("localeconv")
#endif
* to follow the traditional. However, to make the POSIX
* wait W*() macros to work in BeOS, we need to unbend the
* reality back in place. --jhi */
-#ifdef __BEOS__
+/* In actual fact the code below is to blame here. Perl has an internal
+ * representation of the exit status ($?), which it re-composes from the
+ * OS's representation using the W*() POSIX macros. The code below
+ * incorrectly uses the W*() macros on the internal representation,
+ * which fails for OSs that have a different representation (namely BeOS
+ * and Haiku). WMUNGE() is a hack that converts the internal
+ * representation into the OS specific one, so that the W*() macros work
+ * as expected. The better solution would be not to use the W*() macros
+ * in the first place, though. -- Ingo Weinhold
+ */
+#if defined(__BEOS__) || defined(__HAIKU__)
# define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
#else
# define WMUNGE(x) (x)
#endif
static int
-not_here(char *s)
+not_here(const char *s)
{
croak("POSIX::%s not implemented on this architecture", s);
return -1;
#include "const-c.inc"
-/* These were implemented in the old "constant" subroutine. They are actually
- macros that take an integer argument and return an integer result. */
-static int
-int_macro_int (const char *name, STRLEN len, IV *arg_result) {
- /* Initially switch on the length of the name. */
- /* This code has been edited from a "constant" function generated by:
-
-use ExtUtils::Constant qw (constant_types C_constant XS_constant);
+static void
+restore_sigmask(pTHX_ SV *osset_sv)
+{
+ /* Fortunately, restoring the signal mask can't fail, because
+ * there's nothing we can do about it if it does -- we're not
+ * supposed to return -1 from sigaction unless the disposition
+ * was unaffected.
+ */
+ sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
+ (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
+}
-my $types = {map {($_, 1)} qw(IV)};
-my @names = (qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS WIFEXITED
- WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
+static void *
+allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) {
+ SV *const t = newSVrv(rv, packname);
+ void *const p = sv_grow(t, size + 1);
-print constant_types(); # macro defs
-foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) {
- print $_, "\n"; # C constant subs
+ SvCUR_set(t, size);
+ SvPOK_on(t);
+ return p;
}
-print "#### XS Section:\n";
-print XS_constant ("POSIX", $types);
-__END__
- */
-
- switch (len) {
- case 7:
- /* Names all of length 7. */
- /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */
- /* Offset 5 gives the best switch position. */
- switch (name[5]) {
- case 'E':
- if (memEQ(name, "S_ISREG", 7)) {
- /* ^ */
-#ifdef S_ISREG
- *arg_result = S_ISREG(*arg_result);
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 'H':
- if (memEQ(name, "S_ISCHR", 7)) {
- /* ^ */
-#ifdef S_ISCHR
- *arg_result = S_ISCHR(*arg_result);
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 'I':
- if (memEQ(name, "S_ISDIR", 7)) {
- /* ^ */
-#ifdef S_ISDIR
- *arg_result = S_ISDIR(*arg_result);
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 'L':
- if (memEQ(name, "S_ISBLK", 7)) {
- /* ^ */
-#ifdef S_ISBLK
- *arg_result = S_ISBLK(*arg_result);
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- }
- break;
- case 8:
- /* Names all of length 8. */
- /* S_ISFIFO WSTOPSIG WTERMSIG */
- /* Offset 3 gives the best switch position. */
- switch (name[3]) {
- case 'O':
- if (memEQ(name, "WSTOPSIG", 8)) {
- /* ^ */
-#ifdef WSTOPSIG
- int i = *arg_result;
- *arg_result = WSTOPSIG(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 'R':
- if (memEQ(name, "WTERMSIG", 8)) {
- /* ^ */
-#ifdef WTERMSIG
- int i = *arg_result;
- *arg_result = WTERMSIG(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 'S':
- if (memEQ(name, "S_ISFIFO", 8)) {
- /* ^ */
-#ifdef S_ISFIFO
- *arg_result = S_ISFIFO(*arg_result);
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- }
- break;
- case 9:
- if (memEQ(name, "WIFEXITED", 9)) {
-#ifdef WIFEXITED
- int i = *arg_result;
- *arg_result = WIFEXITED(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
+
+#ifdef WIN32
+
+/*
+ * (1) The CRT maintains its own copy of the environment, separate from
+ * the Win32API copy.
+ *
+ * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
+ * copy, and then calls SetEnvironmentVariableA() to update the Win32API
+ * copy.
+ *
+ * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
+ * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
+ * environment.
+ *
+ * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
+ * calls CRT tzset(), but only the first time it is called, and in turn
+ * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
+ * local copy of the environment and hence gets the original setting as
+ * perl never updates the CRT copy when assigning to $ENV{TZ}.
+ *
+ * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
+ * putenv() to update the CRT copy of the environment (if it is different)
+ * whenever we're about to call tzset().
+ *
+ * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
+ * defined:
+ *
+ * (a) Each interpreter has its own copy of the environment inside the
+ * perlhost structure. That allows applications that host multiple
+ * independent Perl interpreters to isolate environment changes from
+ * each other. (This is similar to how the perlhost mechanism keeps a
+ * separate working directory for each Perl interpreter, so that calling
+ * chdir() will not affect other interpreters.)
+ *
+ * (b) Only the first Perl interpreter instantiated within a process will
+ * "write through" environment changes to the process environment.
+ *
+ * (c) Even the primary Perl interpreter won't update the CRT copy of the
+ * the environment, only the Win32API copy (it calls win32_putenv()).
+ *
+ * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
+ * sense to only update the process environment when inside the main
+ * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
+ * from here so we'll just have to check PL_curinterp instead.
+ *
+ * Therefore, we can simply #undef getenv() and putenv() so that those names
+ * always refer to the CRT functions, and explicitly call win32_getenv() to
+ * access perl's %ENV.
+ *
+ * We also #undef malloc() and free() to be sure we are using the CRT
+ * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
+ * into VMem::Malloc() and VMem::Free() and all allocations will be freed
+ * when the Perl interpreter is being destroyed so we'd end up with a pointer
+ * into deallocated memory in environ[] if a program embedding a Perl
+ * interpreter continues to operate even after the main Perl interpreter has
+ * been destroyed.
+ *
+ * Note that we don't free() the malloc()ed memory unless and until we call
+ * malloc() again ourselves because the CRT putenv() function simply puts its
+ * pointer argument into the environ[] array (it doesn't make a copy of it)
+ * so this memory must otherwise be leaked.
+ */
+
+#undef getenv
+#undef putenv
+#undef malloc
+#undef free
+
+static void
+fix_win32_tzenv(void)
+{
+ static char* oldenv = NULL;
+ char* newenv;
+ const char* perl_tz_env = win32_getenv("TZ");
+ const char* crt_tz_env = getenv("TZ");
+ if (perl_tz_env == NULL)
+ perl_tz_env = "";
+ if (crt_tz_env == NULL)
+ crt_tz_env = "";
+ if (strcmp(perl_tz_env, crt_tz_env) != 0) {
+ newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
+ if (newenv != NULL) {
+ sprintf(newenv, "TZ=%s", perl_tz_env);
+ putenv(newenv);
+ if (oldenv != NULL)
+ free(oldenv);
+ oldenv = newenv;
+ }
}
- break;
- case 10:
- if (memEQ(name, "WIFSTOPPED", 10)) {
-#ifdef WIFSTOPPED
- int i = *arg_result;
- *arg_result = WIFSTOPPED(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
+}
+
#endif
- }
- break;
- case 11:
- /* Names all of length 11. */
- /* WEXITSTATUS WIFSIGNALED */
- /* Offset 1 gives the best switch position. */
- switch (name[1]) {
- case 'E':
- if (memEQ(name, "WEXITSTATUS", 11)) {
- /* ^ */
-#ifdef WEXITSTATUS
- int i = *arg_result;
- *arg_result = WEXITSTATUS(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
+
+/*
+ * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
+ * This code is duplicated in the Time-Piece module, so any changes made here
+ * should be made there too.
+ */
+static void
+my_tzset(pTHX)
+{
+#ifdef WIN32
+#if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+ if (PL_curinterp == aTHX)
#endif
- }
- break;
- case 'I':
- if (memEQ(name, "WIFSIGNALED", 11)) {
- /* ^ */
-#ifdef WIFSIGNALED
- int i = *arg_result;
- *arg_result = WIFSIGNALED(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
+ fix_win32_tzenv();
#endif
- }
- break;
+ tzset();
+}
+
+typedef int (*isfunc_t)(int);
+typedef void (*any_dptr_t)(void *);
+
+/* This needs to be ALIASed in a custom way, hence can't easily be defined as
+ a regular XSUB. */
+static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */
+static XSPROTO(is_common)
+{
+ dXSARGS;
+ SV *charstring;
+ if (items != 1)
+ croak_xs_usage(cv, "charstring");
+
+ {
+ dXSTARG;
+ STRLEN len;
+ int RETVAL;
+ unsigned char *s = (unsigned char *) SvPV(ST(0), len);
+ unsigned char *e = s + len;
+ isfunc_t isfunc = (isfunc_t) XSANY.any_dptr;
+
+ for (RETVAL = 1; RETVAL && s < e; s++)
+ if (!isfunc(*s))
+ RETVAL = 0;
+ XSprePUSH;
+ PUSHi((IV)RETVAL);
}
- break;
- }
- return PERL_constant_NOTFOUND;
+ XSRETURN(1);
}
-static void
-restore_sigmask(pTHX_ SV *osset_sv)
+MODULE = POSIX PACKAGE = POSIX
+
+BOOT:
{
- /* Fortunately, restoring the signal mask can't fail, because
- * there's nothing we can do about it if it does -- we're not
- * supposed to return -1 from sigaction unless the disposition
- * was unaffected.
- */
- sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
- (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
+ CV *cv;
+ const char *file = __FILE__;
+
+ /* Ensure we get the function, not a macro implementation. Like the C89
+ standard says we can... */
+#undef isalnum
+ cv = newXS("POSIX::isalnum", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &isalnum;
+#undef isalpha
+ cv = newXS("POSIX::isalpha", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &isalpha;
+#undef iscntrl
+ cv = newXS("POSIX::iscntrl", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &iscntrl;
+#undef isdigit
+ cv = newXS("POSIX::isdigit", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &isdigit;
+#undef isgraph
+ cv = newXS("POSIX::isgraph", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &isgraph;
+#undef islower
+ cv = newXS("POSIX::islower", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &islower;
+#undef isprint
+ cv = newXS("POSIX::isprint", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &isprint;
+#undef ispunct
+ cv = newXS("POSIX::ispunct", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &ispunct;
+#undef isspace
+ cv = newXS("POSIX::isspace", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &isspace;
+#undef isupper
+ cv = newXS("POSIX::isupper", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &isupper;
+#undef isxdigit
+ cv = newXS("POSIX::isxdigit", is_common, file);
+ XSANY.any_dptr = (any_dptr_t) &isxdigit;
}
MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
-POSIX::SigSet
+void
new(packname = "POSIX::SigSet", ...)
- char * packname
+ const char * packname
CODE:
{
int i;
- New(0, RETVAL, 1, sigset_t);
- sigemptyset(RETVAL);
+ sigset_t *const s
+ = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
+ sizeof(sigset_t),
+ packname);
+ sigemptyset(s);
for (i = 1; i < items; i++)
- sigaddset(RETVAL, SvIV(ST(i)));
+ sigaddset(s, SvIV(ST(i)));
+ XSRETURN(1);
}
- OUTPUT:
- RETVAL
-
-void
-DESTROY(sigset)
- POSIX::SigSet sigset
- CODE:
- Safefree(sigset);
-
-SysRet
-sigaddset(sigset, sig)
- POSIX::SigSet sigset
- int sig
SysRet
-sigdelset(sigset, sig)
+addset(sigset, sig)
POSIX::SigSet sigset
int sig
+ ALIAS:
+ delset = 1
+ CODE:
+ RETVAL = ix ? sigdelset(sigset, sig) : sigaddset(sigset, sig);
+ OUTPUT:
+ RETVAL
SysRet
-sigemptyset(sigset)
- POSIX::SigSet sigset
-
-SysRet
-sigfillset(sigset)
+emptyset(sigset)
POSIX::SigSet sigset
+ ALIAS:
+ fillset = 1
+ CODE:
+ RETVAL = ix ? sigfillset(sigset) : sigemptyset(sigset);
+ OUTPUT:
+ RETVAL
int
sigismember(sigset, sig)
POSIX::SigSet sigset
int sig
-
MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
-POSIX::Termios
+void
new(packname = "POSIX::Termios", ...)
- char * packname
+ const char * packname
CODE:
{
#ifdef I_TERMIOS
- New(0, RETVAL, 1, struct termios);
+ void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
+ sizeof(struct termios), packname);
+ /* The previous implementation stored a pointer to an uninitialised
+ struct termios. Seems safer to initialise it, particularly as
+ this implementation exposes the struct to prying from perl-space.
+ */
+ memset(p, 0, 1 + sizeof(struct termios));
+ XSRETURN(1);
#else
not_here("termios");
- RETVAL = 0;
#endif
}
- OUTPUT:
- RETVAL
-
-void
-DESTROY(termios_ref)
- POSIX::Termios termios_ref
- CODE:
-#ifdef I_TERMIOS
- Safefree(termios_ref);
-#else
- not_here("termios");
-#endif
SysRet
getattr(termios_ref, fd = 0)
OUTPUT:
RETVAL
+# If we define TCSANOW here then both a found and not found constant sub
+# are created causing a Constant subroutine TCSANOW redefined warning
+#ifndef TCSANOW
+# define DEF_SETATTR_ACTION 0
+#else
+# define DEF_SETATTR_ACTION TCSANOW
+#endif
SysRet
-setattr(termios_ref, fd = 0, optional_actions = 0)
+setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
POSIX::Termios termios_ref
int fd
int optional_actions
CODE:
+ /* The second argument to the call is mandatory, but we'd like to give
+ it a useful default. 0 isn't valid on all operating systems - on
+ Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
+ values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF. */
RETVAL = tcsetattr(fd, optional_actions, termios_ref);
OUTPUT:
RETVAL
speed_t
-cfgetispeed(termios_ref)
- POSIX::Termios termios_ref
-
-speed_t
-cfgetospeed(termios_ref)
- POSIX::Termios termios_ref
-
-tcflag_t
-getiflag(termios_ref)
- POSIX::Termios termios_ref
- CODE:
-#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
- RETVAL = termios_ref->c_iflag;
-#else
- not_here("getiflag");
- RETVAL = 0;
-#endif
- OUTPUT:
- RETVAL
-
-tcflag_t
-getoflag(termios_ref)
- POSIX::Termios termios_ref
- CODE:
-#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
- RETVAL = termios_ref->c_oflag;
-#else
- not_here("getoflag");
- RETVAL = 0;
-#endif
- OUTPUT:
- RETVAL
-
-tcflag_t
-getcflag(termios_ref)
+getispeed(termios_ref)
POSIX::Termios termios_ref
+ ALIAS:
+ getospeed = 1
CODE:
-#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
- RETVAL = termios_ref->c_cflag;
-#else
- not_here("getcflag");
- RETVAL = 0;
-#endif
+ RETVAL = ix ? cfgetospeed(termios_ref) : cfgetispeed(termios_ref);
OUTPUT:
RETVAL
tcflag_t
-getlflag(termios_ref)
+getiflag(termios_ref)
POSIX::Termios termios_ref
+ ALIAS:
+ getoflag = 1
+ getcflag = 2
+ getlflag = 3
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
- RETVAL = termios_ref->c_lflag;
+ switch(ix) {
+ case 0:
+ RETVAL = termios_ref->c_iflag;
+ break;
+ case 1:
+ RETVAL = termios_ref->c_oflag;
+ break;
+ case 2:
+ RETVAL = termios_ref->c_cflag;
+ break;
+ case 3:
+ RETVAL = termios_ref->c_lflag;
+ break;
+ }
#else
- not_here("getlflag");
- RETVAL = 0;
+ not_here(GvNAME(CvGV(cv)));
+ RETVAL = 0;
#endif
OUTPUT:
RETVAL
cc_t
getcc(termios_ref, ccix)
POSIX::Termios termios_ref
- int ccix
+ unsigned int ccix
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
if (ccix >= NCCS)
RETVAL
SysRet
-cfsetispeed(termios_ref, speed)
+setispeed(termios_ref, speed)
POSIX::Termios termios_ref
speed_t speed
-
-SysRet
-cfsetospeed(termios_ref, speed)
- POSIX::Termios termios_ref
- speed_t speed
-
-void
-setiflag(termios_ref, iflag)
- POSIX::Termios termios_ref
- tcflag_t iflag
+ ALIAS:
+ setospeed = 1
CODE:
-#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
- termios_ref->c_iflag = iflag;
-#else
- not_here("setiflag");
-#endif
-
-void
-setoflag(termios_ref, oflag)
- POSIX::Termios termios_ref
- tcflag_t oflag
- CODE:
-#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
- termios_ref->c_oflag = oflag;
-#else
- not_here("setoflag");
-#endif
-
-void
-setcflag(termios_ref, cflag)
- POSIX::Termios termios_ref
- tcflag_t cflag
- CODE:
-#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
- termios_ref->c_cflag = cflag;
-#else
- not_here("setcflag");
-#endif
+ RETVAL = ix
+ ? cfsetospeed(termios_ref, speed) : cfsetispeed(termios_ref, speed);
+ OUTPUT:
+ RETVAL
void
-setlflag(termios_ref, lflag)
+setiflag(termios_ref, flag)
POSIX::Termios termios_ref
- tcflag_t lflag
+ tcflag_t flag
+ ALIAS:
+ setoflag = 1
+ setcflag = 2
+ setlflag = 3
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
- termios_ref->c_lflag = lflag;
+ switch(ix) {
+ case 0:
+ termios_ref->c_iflag = flag;
+ break;
+ case 1:
+ termios_ref->c_oflag = flag;
+ break;
+ case 2:
+ termios_ref->c_cflag = flag;
+ break;
+ case 3:
+ termios_ref->c_lflag = flag;
+ break;
+ }
#else
- not_here("setlflag");
+ not_here(GvNAME(CvGV(cv)));
#endif
void
setcc(termios_ref, ccix, cc)
POSIX::Termios termios_ref
- int ccix
+ unsigned int ccix
cc_t cc
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
INCLUDE: const-xs.inc
-void
-int_macro_int(sv, iv)
- PREINIT:
- dXSTARG;
- STRLEN len;
- int type;
- INPUT:
- SV * sv;
- const char * s = SvPV(sv, len);
- IV iv;
- PPCODE:
- /* Change this to int_macro_int(s, len, &iv, &nv);
- if you need to return both NVs and IVs */
- type = int_macro_int(s, len, &iv);
- /* Return 1 or 2 items. First is error message, or undef if no error.
- Second, if present, is found value */
- switch (type) {
- case PERL_constant_NOTFOUND:
- sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s));
- EXTEND(SP, 1);
- PUSHs(&PL_sv_undef);
- PUSHs(sv);
- break;
- case PERL_constant_NOTDEF:
- sv = sv_2mortal(newSVpvf(
- "Your vendor has not defined POSIX macro %s, used", s));
- EXTEND(SP, 1);
- PUSHs(&PL_sv_undef);
- PUSHs(sv);
- break;
- case PERL_constant_ISIV:
- PUSHi(iv);
- break;
- default:
- sv = sv_2mortal(newSVpvf(
- "Unexpected return type %d while processing POSIX macro %s, used",
- type, s));
- EXTEND(SP, 1);
- PUSHs(&PL_sv_undef);
- PUSHs(sv);
- }
-
int
-isalnum(charstring)
- unsigned char * charstring
+WEXITSTATUS(status)
+ int status
+ ALIAS:
+ POSIX::WIFEXITED = 1
+ POSIX::WIFSIGNALED = 2
+ POSIX::WIFSTOPPED = 3
+ POSIX::WSTOPSIG = 4
+ POSIX::WTERMSIG = 5
CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!isalnum(*s))
- RETVAL = 0;
- OUTPUT:
- RETVAL
-
-int
-isalpha(charstring)
- unsigned char * charstring
- CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!isalpha(*s))
- RETVAL = 0;
- OUTPUT:
- RETVAL
-
-int
-iscntrl(charstring)
- unsigned char * charstring
- CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!iscntrl(*s))
- RETVAL = 0;
- OUTPUT:
- RETVAL
-
-int
-isdigit(charstring)
- unsigned char * charstring
- CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!isdigit(*s))
- RETVAL = 0;
- OUTPUT:
- RETVAL
-
-int
-isgraph(charstring)
- unsigned char * charstring
- CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!isgraph(*s))
- RETVAL = 0;
- OUTPUT:
- RETVAL
-
-int
-islower(charstring)
- unsigned char * charstring
- CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!islower(*s))
- RETVAL = 0;
- OUTPUT:
- RETVAL
-
-int
-isprint(charstring)
- unsigned char * charstring
- CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!isprint(*s))
- RETVAL = 0;
- OUTPUT:
- RETVAL
-
-int
-ispunct(charstring)
- unsigned char * charstring
- CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!ispunct(*s))
- RETVAL = 0;
- OUTPUT:
- RETVAL
-
-int
-isspace(charstring)
- unsigned char * charstring
- CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!isspace(*s))
- RETVAL = 0;
- OUTPUT:
- RETVAL
-
-int
-isupper(charstring)
- unsigned char * charstring
- CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!isupper(*s))
- RETVAL = 0;
- OUTPUT:
- RETVAL
-
-int
-isxdigit(charstring)
- unsigned char * charstring
- CODE:
- unsigned char *s = charstring;
- unsigned char *e = s + SvCUR(ST(0));
- for (RETVAL = 1; RETVAL && s < e; s++)
- if (!isxdigit(*s))
- RETVAL = 0;
+#if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
+ || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
+ RETVAL = 0; /* Silence compilers that notice this, but don't realise
+ that not_here() can't return. */
+#endif
+ switch(ix) {
+ case 0:
+#ifdef WEXITSTATUS
+ RETVAL = WEXITSTATUS(WMUNGE(status));
+#else
+ not_here("WEXITSTATUS");
+#endif
+ break;
+ case 1:
+#ifdef WIFEXITED
+ RETVAL = WIFEXITED(WMUNGE(status));
+#else
+ not_here("WIFEXITED");
+#endif
+ break;
+ case 2:
+#ifdef WIFSIGNALED
+ RETVAL = WIFSIGNALED(WMUNGE(status));
+#else
+ not_here("WIFSIGNALED");
+#endif
+ break;
+ case 3:
+#ifdef WIFSTOPPED
+ RETVAL = WIFSTOPPED(WMUNGE(status));
+#else
+ not_here("WIFSTOPPED");
+#endif
+ break;
+ case 4:
+#ifdef WSTOPSIG
+ RETVAL = WSTOPSIG(WMUNGE(status));
+#else
+ not_here("WSTOPSIG");
+#endif
+ break;
+ case 5:
+#ifdef WTERMSIG
+ RETVAL = WTERMSIG(WMUNGE(status));
+#else
+ not_here("WTERMSIG");
+#endif
+ break;
+ default:
+ Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
+ }
OUTPUT:
RETVAL
#ifdef HAS_LOCALECONV
struct lconv *lcbuf;
RETVAL = newHV();
+ sv_2mortal((SV*)RETVAL);
if ((lcbuf = localeconv())) {
- /* the strings */
- if (lcbuf->decimal_point && *lcbuf->decimal_point)
- hv_store(RETVAL, "decimal_point", 13,
- newSVpv(lcbuf->decimal_point, 0), 0);
- if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
- hv_store(RETVAL, "thousands_sep", 13,
- newSVpv(lcbuf->thousands_sep, 0), 0);
-#ifndef NO_LOCALECONV_GROUPING
- if (lcbuf->grouping && *lcbuf->grouping)
- hv_store(RETVAL, "grouping", 8,
- newSVpv(lcbuf->grouping, 0), 0);
-#endif
- if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
- hv_store(RETVAL, "int_curr_symbol", 15,
- newSVpv(lcbuf->int_curr_symbol, 0), 0);
- if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
- hv_store(RETVAL, "currency_symbol", 15,
- newSVpv(lcbuf->currency_symbol, 0), 0);
- if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
- hv_store(RETVAL, "mon_decimal_point", 17,
- newSVpv(lcbuf->mon_decimal_point, 0), 0);
-#ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
- if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
- hv_store(RETVAL, "mon_thousands_sep", 17,
- newSVpv(lcbuf->mon_thousands_sep, 0), 0);
-#endif
-#ifndef NO_LOCALECONV_MON_GROUPING
- if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
- hv_store(RETVAL, "mon_grouping", 12,
- newSVpv(lcbuf->mon_grouping, 0), 0);
-#endif
- if (lcbuf->positive_sign && *lcbuf->positive_sign)
- hv_store(RETVAL, "positive_sign", 13,
- newSVpv(lcbuf->positive_sign, 0), 0);
- if (lcbuf->negative_sign && *lcbuf->negative_sign)
- hv_store(RETVAL, "negative_sign", 13,
- newSVpv(lcbuf->negative_sign, 0), 0);
- /* the integers */
- if (lcbuf->int_frac_digits != CHAR_MAX)
- hv_store(RETVAL, "int_frac_digits", 15,
- newSViv(lcbuf->int_frac_digits), 0);
- if (lcbuf->frac_digits != CHAR_MAX)
- hv_store(RETVAL, "frac_digits", 11,
- newSViv(lcbuf->frac_digits), 0);
- if (lcbuf->p_cs_precedes != CHAR_MAX)
- hv_store(RETVAL, "p_cs_precedes", 13,
- newSViv(lcbuf->p_cs_precedes), 0);
- if (lcbuf->p_sep_by_space != CHAR_MAX)
- hv_store(RETVAL, "p_sep_by_space", 14,
- newSViv(lcbuf->p_sep_by_space), 0);
- if (lcbuf->n_cs_precedes != CHAR_MAX)
- hv_store(RETVAL, "n_cs_precedes", 13,
- newSViv(lcbuf->n_cs_precedes), 0);
- if (lcbuf->n_sep_by_space != CHAR_MAX)
- hv_store(RETVAL, "n_sep_by_space", 14,
- newSViv(lcbuf->n_sep_by_space), 0);
- if (lcbuf->p_sign_posn != CHAR_MAX)
- hv_store(RETVAL, "p_sign_posn", 11,
- newSViv(lcbuf->p_sign_posn), 0);
- if (lcbuf->n_sign_posn != CHAR_MAX)
- hv_store(RETVAL, "n_sign_posn", 11,
- newSViv(lcbuf->n_sign_posn), 0);
+ const struct lconv_offset *strings = lconv_strings;
+ const struct lconv_offset *integers = lconv_integers;
+ const char *ptr = (const char *) lcbuf;
+
+ do {
+ const char *value = *((const char **)(ptr + strings->offset));
+
+ if (value && *value)
+ (void) hv_store(RETVAL, strings->name, strlen(strings->name),
+ newSVpv(value, 0), 0);
+ } while ((++strings)->name);
+
+ do {
+ const char value = *((const char *)(ptr + integers->offset));
+
+ if (value != CHAR_MAX)
+ (void) hv_store(RETVAL, integers->name,
+ strlen(integers->name), newSViv(value), 0);
+ } while ((++integers)->name);
}
#else
localeconv(); /* A stub to call not_here(). */
setlocale(category, locale = 0)
int category
char * locale
+ PREINIT:
+ char * retval;
CODE:
- RETVAL = setlocale(category, locale);
- if (RETVAL) {
+ retval = setlocale(category, locale);
+ if (retval) {
+ /* Save retval since subsequent setlocale() calls
+ * may overwrite it. */
+ RETVAL = savepv(retval);
#ifdef USE_LOCALE_CTYPE
if (category == LC_CTYPE
#ifdef LC_ALL
}
#endif /* USE_LOCALE_NUMERIC */
}
+ else
+ RETVAL = NULL;
OUTPUT:
RETVAL
-
+ CLEANUP:
+ if (RETVAL)
+ Safefree(RETVAL);
NV
acos(x)
NV x
-
-NV
-asin(x)
- NV x
-
-NV
-atan(x)
- NV x
-
-NV
-ceil(x)
- NV x
-
-NV
-cosh(x)
- NV x
-
-NV
-floor(x)
- NV x
+ ALIAS:
+ asin = 1
+ atan = 2
+ ceil = 3
+ cosh = 4
+ floor = 5
+ log10 = 6
+ sinh = 7
+ tan = 8
+ tanh = 9
+ CODE:
+ switch (ix) {
+ case 0:
+ RETVAL = acos(x);
+ break;
+ case 1:
+ RETVAL = asin(x);
+ break;
+ case 2:
+ RETVAL = atan(x);
+ break;
+ case 3:
+ RETVAL = ceil(x);
+ break;
+ case 4:
+ RETVAL = cosh(x);
+ break;
+ case 5:
+ RETVAL = floor(x);
+ break;
+ case 6:
+ RETVAL = log10(x);
+ break;
+ case 7:
+ RETVAL = sinh(x);
+ break;
+ case 8:
+ RETVAL = tan(x);
+ break;
+ default:
+ RETVAL = tanh(x);
+ }
+ OUTPUT:
+ RETVAL
NV
fmod(x,y)
NV x
int exp
-NV
-log10(x)
- NV x
-
void
modf(x)
NV x
PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
PUSHs(sv_2mortal(newSVnv(intvar)));
-NV
-sinh(x)
- NV x
-
-NV
-tan(x)
- NV x
-
-NV
-tanh(x)
- NV x
-
SysRet
sigaction(sig, optaction, oldaction = 0)
int sig
# interface look beautiful, which is hard.
{
+ dVAR;
POSIX__SigAction action;
- GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
+ GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
struct sigaction act;
struct sigaction oact;
sigset_t sset;
sigset_t osset;
POSIX__SigSet sigset;
SV** svp;
- SV** sigsvp = hv_fetch(GvHVn(siggv),
- PL_sig_name[sig],
- strlen(PL_sig_name[sig]),
- TRUE);
+ SV** sigsvp;
+
+ if (sig < 0) {
+ croak("Negative signals are not allowed");
+ }
+
+ if (sig == 0 && SvPOK(ST(0))) {
+ const char *s = SvPVX_const(ST(0));
+ int i = whichsig(s);
+
+ if (i < 0 && memEQ(s, "SIG", 3))
+ i = whichsig(s + 3);
+ if (i < 0) {
+ if (ckWARN(WARN_SIGNAL))
+ Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
+ "No such signal: SIG%s", s);
+ XSRETURN_UNDEF;
+ }
+ else
+ sig = i;
+ }
+#ifdef NSIG
+ if (sig > NSIG) { /* NSIG - 1 is still okay. */
+ Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
+ "No such signal: %d", sig);
+ XSRETURN_UNDEF;
+ }
+#endif
+ sigsvp = hv_fetch(GvHVn(siggv),
+ PL_sig_name[sig],
+ strlen(PL_sig_name[sig]),
+ TRUE);
/* Check optaction and set action */
if(SvTRUE(optaction)) {
XSRETURN_UNDEF;
ENTER;
/* Restore signal mask no matter how we exit this block. */
- osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));
+ osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
SAVEFREESV( osset_sv );
SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
/* Remember old disposition if desired. */
if (oldaction) {
- svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
+ svp = hv_fetchs(oldaction, "HANDLER", TRUE);
if(!svp)
croak("Can't supply an oldaction without a HANDLER");
if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
sv_setsv(*svp, *sigsvp);
}
else {
- sv_setpv(*svp, "DEFAULT");
+ sv_setpvs(*svp, "DEFAULT");
}
RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
- if(RETVAL == -1)
+ if(RETVAL == -1) {
+ LEAVE;
XSRETURN_UNDEF;
+ }
/* Get back the mask. */
- svp = hv_fetch(oldaction, "MASK", 4, TRUE);
+ svp = hv_fetchs(oldaction, "MASK", TRUE);
if (sv_isa(*svp, "POSIX::SigSet")) {
- IV tmp = SvIV((SV*)SvRV(*svp));
- sigset = INT2PTR(sigset_t*, tmp);
+ sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
}
else {
- New(0, sigset, 1, sigset_t);
- sv_setptrobj(*svp, sigset, "POSIX::SigSet");
+ sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
+ sizeof(sigset_t),
+ "POSIX::SigSet");
}
*sigset = oact.sa_mask;
/* Get back the flags. */
- svp = hv_fetch(oldaction, "FLAGS", 5, TRUE);
+ svp = hv_fetchs(oldaction, "FLAGS", TRUE);
sv_setiv(*svp, oact.sa_flags);
+
+ /* Get back whether the old handler used safe signals. */
+ svp = hv_fetchs(oldaction, "SAFE", TRUE);
+ sv_setiv(*svp,
+ /* compare incompatible pointers by casting to integer */
+ PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
}
if (action) {
- /* Vector new handler through %SIG. (We always use sighandler
- for the C signal handler, which reads %SIG to dispatch.) */
- svp = hv_fetch(action, "HANDLER", 7, FALSE);
+ /* Safe signals use "csighandler", which vectors through the
+ PL_sighandlerp pointer when it's safe to do so.
+ (BTW, "csighandler" is very different from "sighandler".) */
+ svp = hv_fetchs(action, "SAFE", FALSE);
+ act.sa_handler =
+ DPTR2FPTR(
+ void (*)(int),
+ (*svp && SvTRUE(*svp))
+ ? PL_csighandlerp : PL_sighandlerp
+ );
+
+ /* Vector new Perl handler through %SIG.
+ (The core signal handlers read %SIG to dispatch.) */
+ svp = hv_fetchs(action, "HANDLER", FALSE);
if (!svp)
croak("Can't supply an action without a HANDLER");
sv_setsv(*sigsvp, *svp);
- mg_set(*sigsvp); /* handles DEFAULT and IGNORE */
+
+ /* This call actually calls sigaction() with almost the
+ right settings, including appropriate interpretation
+ of DEFAULT and IGNORE. However, why are we doing
+ this when we're about to do it again just below? XXX */
+ SvSETMAGIC(*sigsvp);
+
+ /* And here again we duplicate -- DEFAULT/IGNORE checking. */
if(SvPOK(*svp)) {
- char *s=SvPVX(*svp);
+ const char *s=SvPVX_const(*svp);
if(strEQ(s,"IGNORE")) {
act.sa_handler = SIG_IGN;
}
else if(strEQ(s,"DEFAULT")) {
act.sa_handler = SIG_DFL;
}
- else {
- act.sa_handler = PL_sighandlerp;
- }
- }
- else {
- act.sa_handler = PL_sighandlerp;
}
/* Set up any desired mask. */
- svp = hv_fetch(action, "MASK", 4, FALSE);
+ svp = hv_fetchs(action, "MASK", FALSE);
if (svp && sv_isa(*svp, "POSIX::SigSet")) {
- IV tmp = SvIV((SV*)SvRV(*svp));
- sigset = INT2PTR(sigset_t*, tmp);
+ sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
act.sa_mask = *sigset;
}
else
sigemptyset(& act.sa_mask);
/* Set up any desired flags. */
- svp = hv_fetch(action, "FLAGS", 5, FALSE);
+ svp = hv_fetchs(action, "FLAGS", FALSE);
act.sa_flags = svp ? SvIV(*svp) : 0;
/* Don't worry about cleaning up *sigsvp if this fails,
* essentially meaningless anyway.
*/
RETVAL = sigaction(sig, & act, (struct sigaction *)0);
- if(RETVAL == -1)
- XSRETURN_UNDEF;
+ if(RETVAL == -1) {
+ LEAVE;
+ XSRETURN_UNDEF;
+ }
}
LEAVE;
SysRet
sigpending(sigset)
POSIX::SigSet sigset
+ ALIAS:
+ sigsuspend = 1
+ CODE:
+ RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
+ OUTPUT:
+ RETVAL
+ CLEANUP:
+ PERL_ASYNC_CHECK();
SysRet
sigprocmask(how, sigset, oldsigset = 0)
int how
- POSIX::SigSet sigset
+ POSIX::SigSet sigset = NO_INIT
POSIX::SigSet oldsigset = NO_INIT
INIT:
- if ( items < 3 ) {
- oldsigset = 0;
- }
- else if (sv_derived_from(ST(2), "POSIX::SigSet")) {
- IV tmp = SvIV((SV*)SvRV(ST(2)));
- oldsigset = INT2PTR(POSIX__SigSet,tmp);
- }
- else {
- New(0, oldsigset, 1, sigset_t);
- sigemptyset(oldsigset);
- sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset);
+ if (! SvOK(ST(1))) {
+ sigset = NULL;
+ } else if (sv_isa(ST(1), "POSIX::SigSet")) {
+ sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
+ } else {
+ croak("sigset is not of type POSIX::SigSet");
}
-SysRet
-sigsuspend(signal_mask)
- POSIX::SigSet signal_mask
+ if (items < 3 || ! SvOK(ST(2))) {
+ oldsigset = NULL;
+ } else if (sv_isa(ST(2), "POSIX::SigSet")) {
+ oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
+ } else {
+ croak("oldsigset is not of type POSIX::SigSet");
+ }
void
_exit(status)
int status
SysRet
-close(fd)
- int fd
-
-SysRet
-dup(fd)
- int fd
-
-SysRet
dup2(fd1, fd2)
int fd1
int fd2
+ CODE:
+#ifdef WIN32
+ /* RT #98912 - More Microsoft muppetry - failing to actually implemented
+ the well known documented POSIX behaviour for a POSIX API.
+ http://msdn.microsoft.com/en-us/library/8syseb29.aspx */
+ RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
+#else
+ RETVAL = dup2(fd1, fd2);
+#endif
+ OUTPUT:
+ RETVAL
SV *
lseek(fd, offset, whence)
OUTPUT:
RETVAL
-SV *
+void
nice(incr)
int incr
PPCODE:
errno = 0;
if ((incr = nice(incr)) != -1 || errno == 0) {
if (incr == 0)
- XPUSHs(sv_2mortal(newSVpvn("0 but true", 10)));
+ XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
else
XPUSHs(sv_2mortal(newSViv(incr)));
}
char * buffer = sv_grow( sv_buffer, nbytes+1 );
CLEANUP:
if (RETVAL >= 0) {
- SvCUR(sv_buffer) = RETVAL;
+ SvCUR_set(sv_buffer, RETVAL);
SvPOK_only(sv_buffer);
*SvEND(sv_buffer) = '\0';
SvTAINTED_on(sv_buffer);
struct utsname buf;
if (uname(&buf) >= 0) {
EXTEND(SP, 5);
- PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
- PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
- PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
- PUSHs(sv_2mortal(newSVpv(buf.version, 0)));
- PUSHs(sv_2mortal(newSVpv(buf.machine, 0)));
+ PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
+ PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
+ PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
+ PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
+ PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
}
#else
uname((char *) 0); /* A stub to call not_here(). */
void
strtoul(str, base = 0)
- char * str
+ const char * str
int base
PREINIT:
unsigned long num;
char *unparsed;
PPCODE:
num = strtoul(str, &unparsed, base);
- if (num <= IV_MAX)
- PUSHs(sv_2mortal(newSViv((IV)num)));
- else
+#if IVSIZE <= LONGSIZE
+ if (num > IV_MAX)
PUSHs(sv_2mortal(newSVnv((double)num)));
+ else
+#endif
+ PUSHs(sv_2mortal(newSViv((IV)num)));
if (GIMME == G_ARRAY) {
EXTEND(SP, 1);
if (unparsed)
STRLEN dstlen;
char *p = SvPV(src,srclen);
srclen++;
- ST(0) = sv_2mortal(NEWSV(800,srclen*4+1));
+ ST(0) = sv_2mortal(newSV(srclen*4+1));
dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
if (dstlen > srclen) {
dstlen++;
strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
dstlen--;
}
- SvCUR(ST(0)) = dstlen;
+ SvCUR_set(ST(0), dstlen);
SvPOK_only(ST(0));
}
mkfifo(filename, mode)
char * filename
Mode_t mode
+ ALIAS:
+ access = 1
CODE:
- TAINT_PROPER("mkfifo");
- RETVAL = mkfifo(filename, mode);
+ if(ix) {
+ RETVAL = access(filename, mode);
+ } else {
+ TAINT_PROPER("mkfifo");
+ RETVAL = mkfifo(filename, mode);
+ }
OUTPUT:
RETVAL
SysRet
tcdrain(fd)
int fd
+ ALIAS:
+ close = 1
+ dup = 2
+ CODE:
+ RETVAL = ix == 1 ? close(fd)
+ : (ix < 1 ? tcdrain(fd) : dup(fd));
+ OUTPUT:
+ RETVAL
SysRet
tcflow(fd, action)
int fd
int action
+ ALIAS:
+ tcflush = 1
+ tcsendbreak = 2
+ CODE:
+ RETVAL = ix == 1 ? tcflush(fd, action)
+ : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
+ OUTPUT:
+ RETVAL
-
-SysRet
-tcflush(fd, queue_selector)
- int fd
- int queue_selector
-
-SysRet
-tcsendbreak(fd, duration)
- int fd
- int duration
-
-char *
-asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
+void
+asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
int sec
int min
int hour
int wday
int yday
int isdst
- CODE:
+ ALIAS:
+ mktime = 1
+ PPCODE:
{
+ dXSTARG;
struct tm mytm;
- init_tm(&mytm); /* XXX workaround - see init_tm() above */
+ init_tm(&mytm); /* XXX workaround - see init_tm() in core util.c */
mytm.tm_sec = sec;
mytm.tm_min = min;
mytm.tm_hour = hour;
mytm.tm_wday = wday;
mytm.tm_yday = yday;
mytm.tm_isdst = isdst;
- RETVAL = asctime(&mytm);
+ if (ix) {
+ const time_t result = mktime(&mytm);
+ if (result == (time_t)-1)
+ SvOK_off(TARG);
+ else if (result == 0)
+ sv_setpvn(TARG, "0 but true", 10);
+ else
+ sv_setiv(TARG, (IV)result);
+ } else {
+ sv_setpv(TARG, asctime(&mytm));
+ }
+ ST(0) = TARG;
+ XSRETURN(1);
}
- OUTPUT:
- RETVAL
long
clock()
Time_t time1
Time_t time2
-SysRetLong
-mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
- int sec
- int min
- int hour
- int mday
- int mon
- int year
- int wday
- int yday
- int isdst
- CODE:
- {
- struct tm mytm;
- init_tm(&mytm); /* XXX workaround - see init_tm() above */
- mytm.tm_sec = sec;
- mytm.tm_min = min;
- mytm.tm_hour = hour;
- mytm.tm_mday = mday;
- mytm.tm_mon = mon;
- mytm.tm_year = year;
- mytm.tm_wday = wday;
- mytm.tm_yday = yday;
- mytm.tm_isdst = isdst;
- RETVAL = mktime(&mytm);
- }
- OUTPUT:
- RETVAL
-
#XXX: if $xsubpp::WantOptimize is always the default
# sv_setpv(TARG, ...) could be used rather than
# ST(0) = sv_2mortal(newSVpv(...))
void
strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
- char * fmt
+ SV * fmt
int sec
int min
int hour
int isdst
CODE:
{
- char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
+ char *buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
if (buf) {
- ST(0) = sv_2mortal(newSVpv(buf, 0));
- Safefree(buf);
+ SV *const sv = sv_newmortal();
+ sv_usepvn_flags(sv, buf, strlen(buf), SV_HAS_TRAILING_NUL);
+ if (SvUTF8(fmt)) {
+ SvUTF8_on(sv);
+ }
+ ST(0) = sv;
}
}
void
tzset()
+ PPCODE:
+ my_tzset(aTHX);
void
tzname()
PPCODE:
EXTEND(SP,2);
- PUSHs(sv_2mortal(newSVpvn(tzname[0],strlen(tzname[0]))));
- PUSHs(sv_2mortal(newSVpvn(tzname[1],strlen(tzname[1]))));
-
-SysRet
-access(filename, mode)
- char * filename
- Mode_t mode
+ PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
+ PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
char *
ctermid(s = 0)
- char * s = 0;
+ char * s = 0;
+ CODE:
+#ifdef HAS_CTERMID_R
+ s = (char *) safemalloc((size_t) L_ctermid);
+#endif
+ RETVAL = ctermid(s);
+ OUTPUT:
+ RETVAL
+ CLEANUP:
+#ifdef HAS_CTERMID_R
+ Safefree(s);
+#endif
char *
cuserid(s = 0)
char * s = 0;
+ CODE:
+#ifdef HAS_CUSERID
+ RETVAL = cuserid(s);
+#else
+ RETVAL = 0;
+ not_here("cuserid");
+#endif
+ OUTPUT:
+ RETVAL
SysRetLong
fpathconf(fd, name)
SysRet
pause()
+ CLEANUP:
+ PERL_ASYNC_CHECK();
+
+unsigned int
+sleep(seconds)
+ unsigned int seconds
+ CODE:
+ RETVAL = PerlProc_sleep(seconds);
+ OUTPUT:
+ RETVAL
SysRet
setgid(gid)
Gid_t gid
+ CLEANUP:
+#ifndef WIN32
+ if (RETVAL >= 0) {
+ PL_gid = getgid();
+ PL_egid = getegid();
+ }
+#endif
SysRet
setuid(uid)
Uid_t uid
+ CLEANUP:
+#ifndef WIN32
+ if (RETVAL >= 0) {
+ PL_uid = getuid();
+ PL_euid = geteuid();
+ }
+#endif
SysRetLong
sysconf(name)
XSprePUSH; PUSHTARG;
}
+SysRet
+lchown(uid, gid, path)
+ Uid_t uid
+ Gid_t gid
+ char * path
+ CODE:
+#ifdef HAS_LCHOWN
+ /* yes, the order of arguments is different,
+ * but consistent with CORE::chown() */
+ RETVAL = lchown(path, uid, gid);
+#else
+ RETVAL = not_here("lchown");
+#endif
+ OUTPUT:
+ RETVAL
https://perl5.git.perl.org / perl5.git / blobdiff