#define PERL_EXT_POSIX
#ifdef NETWARE
#define _POSIX_
/*
* Ideally this should be somewhere down in the includes
* but putting it in other places is giving compiler errors.
* Also here I am unable to check for HAS_UNAME since it wouldn't have
* yet come into the file at this stage - sgp 18th Oct 2000
*/
#endif /* NETWARE */
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#define PERLIO_NOT_STDIO 1
#include "perl.h"
#include "XSUB.h"
#if defined(PERL_IMPLICIT_SYS)
# define open PerlLIO_open3
#endif
#include <ctype.h>
#include <dirent.h>
#endif
#include <errno.h>
#ifdef I_FLOAT
#include <float.h>
#endif
#ifdef I_LIMITS
#include <limits.h>
#endif
#include <locale.h>
#include <math.h>
#ifdef I_PWD
#include <pwd.h>
#endif
#include <setjmp.h>
#include <signal.h>
#include <stdarg.h>
#ifdef I_STDDEF
#include <stddef.h>
#endif
#ifdef I_UNISTD
#include <unistd.h>
#endif
/* 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
*/
#if defined(I_TERMIOS)
#include <termios.h>
#endif
#ifdef I_STDLIB
#include <stdlib.h>
#endif
#ifndef __ultrix__
#include <string.h>
#endif
#include <time.h>
#ifdef I_UNISTD
#include <unistd.h>
#endif
#ifdef MACOS_TRADITIONAL
#endif
#include <fcntl.h>
#ifdef HAS_TZNAME
extern char *tzname[];
# endif
#else
#endif
#endif
#if defined(__VMS) && !defined(__POSIX_SOURCE)
# include <libdef.h> /* LIB$_INVARG constant */
# include <starlet.h> /* prototype for sys$gettim() */
# if DECC_VERSION < 50000000
# endif
# define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */
# include <utsname.h>
# endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
/* The POSIX notion of ttyname() is better served by getname() under VMS */
static char ttnambuf[64];
/* The non-POSIX CRTL times() has void return type, so we just get the
current time directly */
dTHX;
/* Get wall time and convert to 10 ms intervals to
* produce the return value that the POSIX standard expects */
# include <ints.h>
vmstime /= 100000;
# else
/* (Older hw or ccs don't have an atomic 64-bit type, so we
* juggle 32-bit ints (and a float) to produce a time_t result
* with minimal loss of information.) */
# endif
/* Fill in the struct tms using the CRTL routine . . .*/
}
#else
#if defined (__CYGWIN__)
#endif
# define sigset_t long
# define pid_t long
# ifdef __BORLANDC__
# endif
# ifdef _MSC_VER
# define mode_t short
# endif
# ifdef __MINGW32__
# define mode_t short
# ifndef tzset
# endif
# ifndef _POSIX_OPEN_MAX
# endif
# endif
#ifndef NETWARE
#endif /* NETWARE */
#else
# ifndef HAS_MKFIFO
# if defined(OS2) || defined(MACOS_TRADITIONAL)
# else /* !( defined OS2 ) */
# ifndef mkfifo
# endif
# endif
# endif /* !HAS_MKFIFO */
# ifdef MACOS_TRADITIONAL
# else
# include <grp.h>
# ifdef HAS_UNAME
# endif
# endif
# ifdef I_UTIME
# include <utime.h>
# endif
#endif /* WIN32 || NETWARE */
#endif /* __VMS */
typedef int SysRet;
typedef long SysRetLong;
typedef sigset_t* POSIX__SigSet;
typedef HV* POSIX__SigAction;
#ifdef I_TERMIOS
typedef struct termios* POSIX__Termios;
#else /* Define termios types to int, and call not_here for the functions.*/
#define POSIX__Termios int
#define speed_t int
#define tcflag_t int
#define cc_t int
#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
#endif
#ifndef HAS_DIFFTIME
#ifndef difftime
#endif
#endif
#ifndef HAS_FPATHCONF
#endif
#ifndef HAS_MKTIME
#endif
#ifndef HAS_NICE
#endif
#ifndef HAS_PATHCONF
#endif
#ifndef HAS_SYSCONF
#endif
#ifndef HAS_READLINK
#endif
#ifndef HAS_SETPGID
#endif
#ifndef HAS_SETSID
#endif
#ifndef HAS_STRCOLL
#endif
#ifndef HAS_STRTOD
#endif
#ifndef HAS_STRTOL
#endif
#ifndef HAS_STRTOUL
#endif
#ifndef HAS_STRXFRM
#endif
#ifndef HAS_TCGETPGRP
#endif
#ifndef HAS_TCSETPGRP
#endif
#ifndef HAS_TIMES
#ifndef NETWARE
#endif /* NETWARE */
#endif
#ifndef HAS_UNAME
#endif
#ifndef HAS_WAITPID
#endif
#ifndef HAS_MBLEN
#ifndef mblen
#endif
#endif
#ifndef HAS_MBSTOWCS
#endif
#ifndef HAS_MBTOWC
#endif
#ifndef HAS_WCSTOMBS
#endif
#ifndef HAS_WCTOMB
#endif
#if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
/* If we don't have these functions, then we wouldn't have gotten a typedef
for wchar_t, the wide character type. Defining wchar_t allows the
functions referencing it to compile. Its actual type is then meaningless,
since without the above functions, all sections using it end up calling
not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
#ifndef wchar_t
#define wchar_t char
#endif
#endif
#ifndef HAS_LOCALECONV
#endif
#ifdef HAS_LONG_DOUBLE
# if LONG_DOUBLESIZE > NVSIZE
# endif
#endif
#ifndef HAS_LONG_DOUBLE
#ifdef LDBL_MAX
#endif
#ifdef LDBL_MIN
#endif
#ifdef LDBL_EPSILON
#endif
#endif
/* Background: in most systems the low byte of the wait status
* is the signal (the lowest 7 bits) and the coredump flag is
* the eight bit, and the second lowest byte is the exit status.
* BeOS bucks the trend and has the bytes in different order.
* 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__
#else
# define WMUNGE(x) (x)
#endif
static int
not_here(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
/* 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);
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));
print constant_types(); # macro defs
foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) {
print $_, "\n"; # C constant subs
}
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':
/* ^ */
#ifdef S_ISREG
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'H':
/* ^ */
#ifdef S_ISCHR
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'I':
/* ^ */
#ifdef S_ISDIR
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'L':
/* ^ */
#ifdef S_ISBLK
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':
/* ^ */
#ifdef WSTOPSIG
int i = *arg_result;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'R':
/* ^ */
#ifdef WTERMSIG
int i = *arg_result;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'S':
/* ^ */
#ifdef S_ISFIFO
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
}
break;
case 9:
#ifdef WIFEXITED
int i = *arg_result;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 10:
#ifdef WIFSTOPPED
int i = *arg_result;
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':
/* ^ */
#ifdef WEXITSTATUS
int i = *arg_result;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
case 'I':
/* ^ */
#ifdef WIFSIGNALED
int i = *arg_result;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
}
break;
}
return PERL_constant_NOTFOUND;
}
static void
{
/* 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.
*/
}
char * packname
CODE:
{
int i;
for (i = 1; i < items; i++)
}
void
CODE:
int sig
int sig
int
int sig
char * packname
CODE:
{
#ifdef I_TERMIOS
#else
not_here("termios");
RETVAL = 0;
#endif
}
void
CODE:
#ifdef I_TERMIOS
#else
not_here("termios");
#endif
int fd
CODE:
int fd
int optional_actions
CODE:
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
#else
not_here("getiflag");
RETVAL = 0;
#endif
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
#else
not_here("getoflag");
RETVAL = 0;
#endif
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
#else
not_here("getcflag");
RETVAL = 0;
#endif
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
#else
not_here("getlflag");
RETVAL = 0;
#endif
int ccix
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
croak("Bad getcc subscript");
#else
not_here("getcc");
RETVAL = 0;
#endif
void
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
#else
not_here("setiflag");
#endif
void
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
#else
not_here("setoflag");
#endif
void
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
#else
not_here("setcflag");
#endif
void
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
#else
not_here("setlflag");
#endif
void
int ccix
CODE:
#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
croak("Bad setcc subscript");
#else
not_here("setcc");
#endif
void
int type;
/* Change this to int_macro_int(s, len, &iv, &nv);
if you need to return both NVs and IVs */
/* 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:
PUSHs(&PL_sv_undef);
break;
case PERL_constant_NOTDEF:
"Your vendor has not defined POSIX macro %s, used", s));
PUSHs(&PL_sv_undef);
break;
case PERL_constant_ISIV:
break;
default:
"Unexpected return type %d while processing POSIX macro %s, used",
type, s));
PUSHs(&PL_sv_undef);
}
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!isalnum(*s))
RETVAL = 0;
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!isalpha(*s))
RETVAL = 0;
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!iscntrl(*s))
RETVAL = 0;
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!isdigit(*s))
RETVAL = 0;
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!isgraph(*s))
RETVAL = 0;
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!islower(*s))
RETVAL = 0;
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!isprint(*s))
RETVAL = 0;
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!ispunct(*s))
RETVAL = 0;
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!isspace(*s))
RETVAL = 0;
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!isupper(*s))
RETVAL = 0;
int
SV * charstring
CODE:
unsigned char *e = s + len;
if (!isxdigit(*s))
RETVAL = 0;
char * filename
int flags
CODE:
TAINT_PROPER("open");
HV *
CODE:
#ifdef HAS_LOCALECONV
if ((lcbuf = localeconv())) {
/* the strings */
#ifndef NO_LOCALECONV_GROUPING
#endif
#ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
#endif
#ifndef NO_LOCALECONV_MON_GROUPING
#endif
/* the integers */
}
#else
localeconv(); /* A stub to call not_here(). */
#endif
char *
int category
char * locale
CODE:
if (RETVAL) {
#ifdef USE_LOCALE_CTYPE
#ifdef LC_ALL
#endif
)
{
char *newctype;
#ifdef LC_ALL
else
#endif
}
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
if (category == LC_COLLATE
#ifdef LC_ALL
#endif
)
{
char *newcoll;
#ifdef LC_ALL
else
#endif
}
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
if (category == LC_NUMERIC
#ifdef LC_ALL
#endif
)
{
char *newnum;
#ifdef LC_ALL
else
#endif
}
#endif /* USE_LOCALE_NUMERIC */
}
acos(x)
NV x
asin(x)
NV x
atan(x)
NV x
ceil(x)
NV x
cosh(x)
NV x
floor(x)
NV x
fmod(x,y)
NV x
NV y
void
frexp(x)
NV x
int expvar;
/* (We already know stack is long enough.) */
NV x
int exp
log10(x)
NV x
void
modf(x)
NV x
/* (We already know stack is long enough.) */
sinh(x)
NV x
tan(x)
NV x
tanh(x)
NV x
int sig
CODE:
#else
# interface look beautiful, which is hard.
{
POSIX__SigAction action;
GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
struct sigaction act;
struct sigaction oact;
sigset_t sset;
SV *osset_sv;
sigset_t osset;
POSIX__SigSet sigset;
SV** svp;
SV** sigsvp;
if (sig == 0 && SvPOK(ST(0))) {
char *s = SvPVX(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;
}
sigsvp = hv_fetch(GvHVn(siggv),
PL_sig_name[sig],
strlen(PL_sig_name[sig]),
TRUE);
/* Check optaction and set action */
if(SvTRUE(optaction)) {
if(sv_isa(optaction, "POSIX::SigAction"))
action = (HV*)SvRV(optaction);
else
croak("action is not of type POSIX::SigAction");
}
else {
action=0;
}
/* sigaction() is supposed to look atomic. In particular, any
* signal handler invoked during a sigaction() call should
* see either the old or the new disposition, and not something
* in between. We use sigprocmask() to make it so.
*/
sigfillset(&sset);
RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
if(RETVAL == -1)
XSRETURN_UNDEF;
ENTER;
/* Restore signal mask no matter how we exit this block. */
osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));
SAVEFREESV( osset_sv );
SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
RETVAL=-1; /* In case both oldaction and action are 0. */
/* Remember old disposition if desired. */
if (oldaction) {
svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
if(!svp)
if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
sv_setsv(*svp, *sigsvp);
}
else {
}
RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
if(RETVAL == -1)
XSRETURN_UNDEF;
/* Get back the mask. */
IV tmp = SvIV((SV*)SvRV(*svp));
sigset = INT2PTR(sigset_t*, tmp);
}
else {
New(0, sigset, 1, sigset_t);
}
*sigset = oact.sa_mask;
/* Get back the flags. */
sv_setiv(*svp, oact.sa_flags);
/* Get back whether the old handler used safe signals. */
sv_setiv(*svp, oact.sa_handler == PL_csighandlerp);
}
if (action) {
PL_sighandlerp pointer when it's safe to do so.
act.sa_handler = (*svp && SvTRUE(*svp))
? PL_csighandlerp : PL_sighandlerp;
/* Vector new Perl handler through %SIG.
(The core signal handlers read %SIG to dispatch.) */
if (!svp)
sv_setsv(*sigsvp, *svp);
/* This call actually calls sigaction() with almost the
right settings, including appropriate interpretation
of DEFAULT and IGNORE. However, why are we doing
if(strEQ(s,"IGNORE")) {
}
else if(strEQ(s,"DEFAULT")) {
}
}
/* Set up any desired mask. */
}
else
/* Set up any desired flags. */
/* Don't worry about cleaning up *sigsvp if this fails,
* because that means we tried to disposition a
* nonblockable signal, in which case *sigsvp is
* essentially meaningless anyway.
*/
if(RETVAL == -1)
}
}
#endif
int how
INIT:
if ( items < 3 ) {
oldsigset = 0;
}
}
else {
}
void
int status
int fd
int fd
int fd1
int fd2
SV *
int fd
int whence
CODE:
void
int incr
errno = 0;
if (incr == 0)
else
}
void
pipe()
int fds[2];
}
int fd
if (RETVAL >= 0) {
}
setsid()
int fd
int fd
void
uname()
#ifdef HAS_UNAME
}
#else
uname((char *) 0); /* A stub to call not_here(). */
#endif
int fd
char * buffer
SV *
tmpnam()
STRLEN i;
int len;
CODE:
void
abort()
int
mblen(s, n)
char * s
size_t n
wchar_t * s
char * pwcs
size_t n
int
char * s
size_t n
int
char * s
size_t n
int
char * s
int
char * s1
char * s2
void
char * str
double num;
char *unparsed;
if (unparsed)
else
PUSHs(&PL_sv_undef);
}
void
char * str
int base
long num;
char *unparsed;
else
#endif
if (unparsed)
else
PUSHs(&PL_sv_undef);
}
void
char * str
int base
unsigned long num;
char *unparsed;
else
#endif
if (unparsed)
else
PUSHs(&PL_sv_undef);
}
void
CODE:
{
srclen++;
dstlen++;
dstlen--;
}
SvPOK_only(ST(0));
}
char * filename
CODE:
TAINT_PROPER("mkfifo");
int fd
int fd
int action
int fd
int queue_selector
int fd
int duration
char *
int sec
int min
int hour
int mday
int mon
int year
int wday
int yday
int isdst
CODE:
{
}
long
clock()
char *
void
times()
double
int sec
int min
int hour
int mday
int mon
int year
int wday
int yday
int isdst
CODE:
{
}
void
char * fmt
int sec
int min
int hour
int mday
int mon
int year
int wday
int yday
int isdst
CODE:
{
if (buf) {
}
}
void
tzset()
void
tzname()
char * filename
char *
ctermid(s = 0)
char * s = 0;
CODE:
#ifdef HAS_CTERMID_R
#endif
#ifdef HAS_CTERMID_R
Safefree(s);
#endif
char *
cuserid(s = 0)
char * s = 0;
int fd
int name
char * filename
int name
pause()
#ifndef WIN32
if (RETVAL >= 0) {
}
#endif
#ifndef WIN32
if (RETVAL >= 0) {
}
#endif
int name
char *
int fd
void
getcwd()
{
}
char * path
CODE:
#ifdef HAS_LCHOWN
/* yes, the order of arguments is different,
* but consistent with CORE::chown() */
#else
#endif