/* pp_sys.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* XXX Configure test needed.
h_errno might not be a simple 'int', especially for multi-threaded
- applications. HOST_NOT_FOUND is typically defined in <netdb.h>.
+ applications, see "extern int errno in perl.h". Creating such
+ a test requires taking into account the differences between
+ compiling multithreaded and singlethreaded ($ccflags et al).
+ HOST_NOT_FOUND is typically defined in <netdb.h>.
*/
#if defined(HOST_NOT_FOUND) && !defined(h_errno)
extern int h_errno;
#endif /* no flock() */
-#ifndef MAXPATHLEN
-# ifdef PATH_MAX
-# define MAXPATHLEN PATH_MAX
-# else
-# define MAXPATHLEN 1024
-# endif
-#endif
-
#define ZBTLEN 10
static char zero_but_true[ZBTLEN + 1] = "0 but true";
-/* Pushy I/O. */
+#if defined(I_SYS_ACCESS) && !defined(R_OK)
+# include <sys/access.h>
+#endif
+
+#undef PERL_EFF_ACCESS_R_OK /* EFFective uid/gid ACCESS R_OK */
+#undef PERL_EFF_ACCESS_W_OK
+#undef PERL_EFF_ACCESS_X_OK
+
+/* F_OK unused: if stat() cannot find it... */
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESS) && defined(EFF_ONLY_OK) && !defined(NO_EFF_ONLY_OK)
+ /* Digital UNIX (when the EFF_ONLY_OK gets fixed), UnixWare */
+# define PERL_EFF_ACCESS_R_OK(p) (access((p), R_OK | EFF_ONLY_OK))
+# define PERL_EFF_ACCESS_W_OK(p) (access((p), W_OK | EFF_ONLY_OK))
+# define PERL_EFF_ACCESS_X_OK(p) (access((p), X_OK | EFF_ONLY_OK))
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_EACCESS)
+# if defined(I_SYS_SECURITY)
+# include <sys/security.h>
+# endif
+ /* XXX Configure test needed for eaccess */
+# ifdef ACC_SELF
+ /* HP SecureWare */
+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
+# else
+ /* SCO */
+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK))
+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK))
+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK))
+# endif
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF)
+ /* AIX */
+# define PERL_EFF_ACCESS_R_OK(p) (accessx((p), R_OK, ACC_SELF))
+# define PERL_EFF_ACCESS_W_OK(p) (accessx((p), W_OK, ACC_SELF))
+# define PERL_EFF_ACCESS_X_OK(p) (accessx((p), X_OK, ACC_SELF))
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESS) \
+ && (defined(HAS_SETREUID) || defined(HAS_SETRESUID) \
+ || defined(HAS_SETREGID) || defined(HAS_SETRESGID))
+/* The Hard Way. */
+STATIC int
+emulate_eaccess (const char* path, int mode) {
+ Uid_t ruid = getuid();
+ Uid_t euid = geteuid();
+ Gid_t rgid = getgid();
+ Gid_t egid = getegid();
+ int res;
+
+ MUTEX_LOCK(&PL_cred_mutex);
+#if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID)
+ croak("switching effective uid is not implemented");
+#else
+#ifdef HAS_SETREUID
+ if (setreuid(euid, ruid))
+#else
+#ifdef HAS_SETRESUID
+ if (setresuid(euid, ruid, (Uid_t)-1))
+#endif
+#endif
+ croak("entering effective uid failed");
+#endif
+
+#if !defined(HAS_SETREGID) && !defined(HAS_SETRESGID)
+ croak("switching effective gid is not implemented");
+#else
+#ifdef HAS_SETREGID
+ if (setregid(egid, rgid))
+#else
+#ifdef HAS_SETRESGID
+ if (setresgid(egid, rgid, (Gid_t)-1))
+#endif
+#endif
+ croak("entering effective gid failed");
+#endif
+
+ res = access(path, mode);
+
+#ifdef HAS_SETREUID
+ if (setreuid(ruid, euid))
+#else
+#ifdef HAS_SETRESUID
+ if (setresuid(ruid, euid, (Uid_t)-1))
+#endif
+#endif
+ croak("leaving effective uid failed");
+
+#ifdef HAS_SETREGID
+ if (setregid(rgid, egid))
+#else
+#ifdef HAS_SETRESGID
+ if (setresgid(rgid, egid, (Gid_t)-1))
+#endif
+#endif
+ croak("leaving effective gid failed");
+ MUTEX_UNLOCK(&PL_cred_mutex);
+
+ return res;
+}
+# define PERL_EFF_ACCESS_R_OK(p) (emulate_eaccess((p), R_OK))
+# define PERL_EFF_ACCESS_W_OK(p) (emulate_eaccess((p), W_OK))
+# define PERL_EFF_ACCESS_X_OK(p) (emulate_eaccess((p), X_OK))
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK)
+STATIC int
+emulate_eaccess (const char* path, int mode) {
+ croak("switching effective uid is not implemented");
+ /*NOTREACHED*/
+ return -1;
+}
+#endif
PP(pp_backtick)
{
djSP; dTARGET;
PerlIO *fp;
- char *tmps = POPp;
+ STRLEN n_a;
+ char *tmps = POPpx;
I32 gimme = GIMME_V;
TAINT_PROPER("``");
PP(pp_glob)
{
OP *result;
+ tryAMAGICunTARGET(iter, -1);
+
ENTER;
#ifndef VMS
* so for security reasons we must assume the worst.
*/
TAINT;
- taint_proper(no_security, "glob");
+ taint_proper(PL_no_security, "glob");
}
#endif /* !VMS */
#if 0 /* XXX never used! */
PP(pp_indread)
{
- PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), PL_na), TRUE,SVt_PVIO);
+ STRLEN n_a;
+ PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), n_a), TRUE,SVt_PVIO);
return do_readline();
}
#endif
{
djSP; dMARK;
char *tmps;
+ STRLEN n_a;
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
- tmps = SvPV(TARG, PL_na);
+ tmps = SvPV(TARG, n_a);
SP = MARK + 1;
}
else {
- tmps = SvPV(TOPs, PL_na);
+ tmps = SvPV(TOPs, n_a);
}
if (!tmps || !*tmps) {
SV *error = ERRSV;
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
- tmps = SvPV(error, PL_na);
+ tmps = SvPV(error, n_a);
}
if (!tmps || !*tmps)
tmps = "Warning: something's wrong";
char *tmps;
SV *tmpsv = Nullsv;
char *pat = "%s";
+ STRLEN n_a;
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
- tmps = SvPV(TARG, PL_na);
+ tmps = SvPV(TARG, n_a);
SP = MARK + 1;
}
else {
tmpsv = TOPs;
- tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, PL_na);
+ tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, n_a);
}
if (!tmps || !*tmps) {
SV *error = ERRSV;
else {
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
- tmps = SvPV(error, PL_na);
+ tmps = SvPV(error, n_a);
}
}
if (!tmps || !*tmps)
if (MAXARG > 1)
sv = POPs;
if (!isGV(TOPs))
- DIE(no_usym, "filehandle");
+ DIE(PL_no_usym, "filehandle");
if (MAXARG <= 1)
sv = GvSV(TOPs);
gv = (GV*)POPs;
if (!isGV(gv))
- DIE(no_usym, "filehandle");
+ DIE(PL_no_usym, "filehandle");
if (GvIOp(gv))
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
tmps = SvPV(sv, len);
else
gv = (GV*)POPs;
- if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ if (mg = SvTIED_mg((SV*)gv, 'q')) {
PUSHMARK(SP);
- XPUSHs(mg->mg_obj);
+ XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
perl_call_method("CLOSE", G_SCALAR);
goto badexit;
if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
- DIE(no_usym, "filehandle");
+ DIE(PL_no_usym, "filehandle");
rstio = GvIOn(rgv);
wstio = GvIOn(wgv);
else PerlLIO_close(fd[1]);
goto badexit;
}
-
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+ fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */
+ fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */
+#endif
RETPUSHYES;
badexit:
RETPUSHUNDEF;
#else
- DIE(no_func, "pipe");
+ DIE(PL_no_func, "pipe");
#endif
}
char *methname;
int how = 'P';
U32 items;
+ STRLEN n_a;
varsv = *++MARK;
switch(SvTYPE(varsv)) {
stash = gv_stashsv(*MARK, FALSE);
if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
DIE("Can't locate object method \"%s\" via package \"%s\"",
- methname, SvPV(*MARK,PL_na));
+ methname, SvPV(*MARK,n_a));
}
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
sv = TOPs;
POPSTACK;
if (sv_isobject(sv)) {
- sv_unmagic(varsv, how);
- sv_magic(varsv, sv, how, Nullch, 0);
+ sv_unmagic(varsv, how);
+ sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
}
LEAVE;
SP = PL_stack_base + markoff;
PP(pp_untie)
{
djSP;
- SV * sv ;
-
- sv = POPs;
+ SV *sv = POPs;
+ char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
if (ckWARN(WARN_UNTIE)) {
MAGIC * mg ;
- if (SvMAGICAL(sv)) {
- if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
- mg = mg_find(sv, 'P') ;
- else
- mg = mg_find(sv, 'q') ;
-
+ if (mg = SvTIED_mg(sv, how)) {
if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)
warner(WARN_UNTIE,
"untie attempted while %lu inner references still exist",
}
}
- if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
- sv_unmagic(sv, 'P');
- else
- sv_unmagic(sv, 'q');
+ sv_unmagic(sv, how);
RETPUSHYES;
}
PP(pp_tied)
{
djSP;
- SV * sv ;
- MAGIC * mg ;
+ SV *sv = POPs;
+ char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
+ MAGIC *mg;
- sv = POPs;
- if (SvMAGICAL(sv)) {
- if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
- mg = mg_find(sv, 'P') ;
- else
- mg = mg_find(sv, 'q') ;
-
- if (mg) {
- PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ;
- RETURN ;
- }
+ if (mg = SvTIED_mg(sv, how)) {
+ SV *osv = SvTIED_obj(sv, mg);
+ if (osv == mg->mg_obj)
+ osv = sv_mortalcopy(osv);
+ PUSHs(osv);
+ RETURN;
}
RETPUSHUNDEF;
}
struct timeval *tbuf = &timebuf;
I32 growsize;
char *fd_sets[4];
+ STRLEN n_a;
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
I32 masksize;
I32 offset;
maxlen = j;
}
+/* little endians can use vecs directly */
#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
-/* XXX Configure test needed. */
-#if defined(__linux__) || defined(OS2) || defined(NeXT) || defined(__osf__) || defined(sun)
+# if SELECT_MIN_BITS > 1
+ /* If SELECT_MIN_BITS is greater than one we most probably will want
+ * to align the sizes with SELECT_MIN_BITS/8 because for example
+ * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
+ * UNIX, Solaris, NeXT, Rhapsody) the smallest quantum select() operates
+ * on (sets/tests/clears bits) is 32 bits. */
+ growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
+# else
growsize = sizeof(fd_set);
-#else
- growsize = maxlen; /* little endians can use vecs directly */
-#endif
-#else
-#ifdef NFDBITS
+# endif
+# else
+# ifdef NFDBITS
-#ifndef NBBY
-#define NBBY 8
-#endif
+# ifndef NBBY
+# define NBBY 8
+# endif
masksize = NFDBITS / NBBY;
-#else
+# else
masksize = sizeof(long); /* documented int, everyone seems to use long */
-#endif
+# endif
growsize = maxlen + (masksize - (maxlen % masksize));
Zero(&fd_sets[0], 4, char*);
#endif
continue;
}
else if (!SvPOK(sv))
- SvPV_force(sv,PL_na); /* force string conversion */
+ SvPV_force(sv,n_a); /* force string conversion */
j = SvLEN(sv);
if (j < growsize) {
Sv_Grow(sv, growsize);
if (!gv)
gv = PL_argvgv;
- if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ if (mg = SvTIED_mg((SV*)gv, 'q')) {
I32 gimme = GIMME_V;
PUSHMARK(SP);
- XPUSHs(mg->mg_obj);
+ XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
perl_call_method("GETC", gimme);
PerlIO *fp;
SV *sv;
MAGIC *mg;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
else
gv = PL_defoutgv;
- if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ if (mg = SvTIED_mg((SV*)gv, 'q')) {
if (MARK == ORIGMARK) {
MEXTEND(SP, 1);
++MARK;
++SP;
}
PUSHMARK(MARK - 1);
- *MARK = mg->mg_obj;
+ *MARK = SvTIED_obj((SV*)gv, mg);
PUTBACK;
ENTER;
perl_call_method("PRINTF", G_SCALAR);
if (!(io = GvIO(gv))) {
if (ckWARN(WARN_UNOPENED)) {
gv_fullname3(sv, gv, Nullch);
- warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,PL_na));
+ warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
}
SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
gv_fullname3(sv, gv, Nullch);
if (IoIFP(io))
warner(WARN_IO, "Filehandle %s opened only for input",
- SvPV(sv,PL_na));
+ SvPV(sv,n_a));
else if (ckWARN(WARN_CLOSED))
warner(WARN_CLOSED, "printf on closed filehandle %s",
- SvPV(sv,PL_na));
+ SvPV(sv,n_a));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
gv = (GV*)*++MARK;
if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
- SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
+ (mg = SvTIED_mg((SV*)gv, 'q')))
{
SV *sv;
PUSHMARK(MARK-1);
- *MARK = mg->mg_obj;
+ *MARK = SvTIED_obj((SV*)gv, mg);
ENTER;
perl_call_method("READ", G_SCALAR);
LEAVE;
}
#else
if (PL_op->op_type == OP_RECV)
- DIE(no_sock_func, "recv");
+ DIE(PL_no_sock_func, "recv");
#endif
if (offset < 0) {
if (-offset > blen)
Zero(buffer+bufsize, offset-bufsize, char);
}
if (PL_op->op_type == OP_SYSREAD) {
- length = PerlLIO_read(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
+#ifdef PERL_SOCK_SYSREAD_IS_RECV
+ if (IoTYPE(io) == 's') {
+ length = PerlSock_recv(PerlIO_fileno(IoIFP(io)),
+ buffer+offset, length, 0);
+ }
+ else
+#endif
+ {
+ length = PerlLIO_read(PerlIO_fileno(IoIFP(io)),
+ buffer+offset, length);
+ }
}
else
#ifdef HAS_SOCKET__bad_code_maybe
PP(pp_syswrite)
{
+ djSP;
+ int items = (SP - PL_stack_base) - TOPMARK;
+ if (items == 2) {
+ SV *sv;
+ EXTEND(SP, 1);
+ sv = sv_2mortal(newSViv(sv_len(*SP)));
+ PUSHs(sv);
+ PUTBACK;
+ }
return pp_send(ARGS);
}
MAGIC *mg;
gv = (GV*)*++MARK;
- if (PL_op->op_type == OP_SYSWRITE &&
- SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
- {
+ if (PL_op->op_type == OP_SYSWRITE && (mg = SvTIED_mg((SV*)gv, 'q'))) {
SV *sv;
PUSHMARK(MARK-1);
- *MARK = mg->mg_obj;
+ *MARK = SvTIED_obj((SV*)gv, mg);
ENTER;
perl_call_method("WRITE", G_SCALAR);
LEAVE;
offset = 0;
if (length > blen - offset)
length = blen - offset;
- length = PerlLIO_write(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
+#ifdef PERL_SOCK_SYSWRITE_IS_SEND
+ if (IoTYPE(io) == 's') {
+ length = PerlSock_send(PerlIO_fileno(IoIFP(io)),
+ buffer+offset, length, 0);
+ }
+ else
+#endif
+ {
+ length = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
+ buffer+offset, length);
+ }
}
#ifdef HAS_SOCKET
else if (SP > MARK) {
#else
else
- DIE(no_sock_func, "send");
+ DIE(PL_no_sock_func, "send");
#endif
if (length < 0)
goto say_undef;
djSP;
GV *gv;
int whence = POPi;
- long offset = POPl;
+ Off_t offset = POPl;
gv = PL_last_in_gv = (GV*)POPs;
if (PL_op->op_type == OP_SEEK)
PUSHs(boolSV(do_seek(gv, offset, whence)));
else {
- long n = do_sysseek(gv, offset, whence);
+ Off_t n = do_sysseek(gv, offset, whence);
PUSHs((n < 0) ? &PL_sv_undef
: sv_2mortal(n ? newSViv((IV)n)
: newSVpv(zero_but_true, ZBTLEN)));
Off_t len = (Off_t)POPn;
int result = 1;
GV *tmpgv;
+ STRLEN n_a;
SETERRNO(0,0);
#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
if (PL_op->op_flags & OPf_SPECIAL) {
- tmpgv = gv_fetchpv(POPp, FALSE, SVt_PVIO);
+ tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
do_ftruncate:
TAINT_PROPER("truncate");
if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
else {
SV *sv = POPs;
char *name;
+ STRLEN n_a;
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv; /* *main::FRED for example */
goto do_ftruncate;
}
- name = SvPV(sv, PL_na);
+ name = SvPV(sv, n_a);
TAINT_PROPER("truncate");
#ifdef HAS_TRUNCATE
if (truncate(name, len) < 0)
if (SvPOK(argsv)) {
if (s[SvCUR(argsv)] != 17)
DIE("Possible memory corruption: %s overflowed 3rd argument",
- op_name[optype]);
+ PL_op_name[optype]);
s[SvCUR(argsv)] = 0; /* put our null back */
SvSETMAGIC(argsv); /* Assume it has changed */
}
PUSHi(value);
RETURN;
#else
- DIE(no_func, "flock()");
+ DIE(PL_no_func, "flock()");
#endif
}
RETPUSHYES;
#else
- DIE(no_sock_func, "socket");
+ DIE(PL_no_sock_func, "socket");
#endif
}
RETPUSHYES;
#else
- DIE(no_sock_func, "socketpair");
+ DIE(PL_no_sock_func, "socketpair");
#endif
}
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
- DIE(no_sock_func, "bind");
+ DIE(PL_no_sock_func, "bind");
#endif
}
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
- DIE(no_sock_func, "connect");
+ DIE(PL_no_sock_func, "connect");
#endif
}
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
- DIE(no_sock_func, "listen");
+ DIE(PL_no_sock_func, "listen");
#endif
}
RETPUSHUNDEF;
#else
- DIE(no_sock_func, "accept");
+ DIE(PL_no_sock_func, "accept");
#endif
}
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
- DIE(no_sock_func, "shutdown");
+ DIE(PL_no_sock_func, "shutdown");
#endif
}
#ifdef HAS_SOCKET
return pp_ssockopt(ARGS);
#else
- DIE(no_sock_func, "getsockopt");
+ DIE(PL_no_sock_func, "getsockopt");
#endif
}
char *buf;
int aint;
if (SvPOKp(sv)) {
- buf = SvPV(sv, PL_na);
- len = PL_na;
+ STRLEN l;
+ buf = SvPV(sv, l);
+ len = l;
}
else {
aint = (int)SvIV(sv);
RETPUSHUNDEF;
#else
- DIE(no_sock_func, "setsockopt");
+ DIE(PL_no_sock_func, "setsockopt");
#endif
}
#ifdef HAS_SOCKET
return pp_getpeername(ARGS);
#else
- DIE(no_sock_func, "getsockname");
+ DIE(PL_no_sock_func, "getsockname");
#endif
}
RETPUSHUNDEF;
#else
- DIE(no_sock_func, "getpeername");
+ DIE(PL_no_sock_func, "getpeername");
#endif
}
GV *tmpgv;
I32 gimme;
I32 max = 13;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
tmpgv = cGVOP->op_gv;
tmpgv = (GV*)SvRV(sv);
goto do_fstat;
}
- sv_setpv(PL_statname, SvPV(sv,PL_na));
+ sv_setpv(PL_statname, SvPV(sv,n_a));
PL_statgv = Nullgv;
#ifdef HAS_LSTAT
PL_laststype = PL_op->op_type;
if (PL_op->op_type == OP_LSTAT)
- PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, PL_na), &PL_statcache);
+ PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache);
else
#endif
- PL_laststatval = PerlLIO_stat(SvPV(PL_statname, PL_na), &PL_statcache);
+ PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
if (PL_laststatval < 0) {
- if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, PL_na), '\n'))
- warner(WARN_NEWLINE, warn_nl, "stat");
+ if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
+ warner(WARN_NEWLINE, PL_warn_nl, "stat");
max = 0;
}
}
PP(pp_ftrread)
{
- I32 result = my_stat(ARGS);
+ I32 result;
djSP;
+#if defined(HAS_ACCESS) && defined(R_OK)
+ STRLEN n_a;
+ if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+ result = access(TOPpx, R_OK);
+ if (result == 0)
+ RETPUSHYES;
+ if (result < 0)
+ RETPUSHUNDEF;
+ RETPUSHNO;
+ }
+ else
+ result = my_stat(ARGS);
+#else
+ result = my_stat(ARGS);
+#endif
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IRUSR, 0, &PL_statcache))
PP(pp_ftrwrite)
{
- I32 result = my_stat(ARGS);
+ I32 result;
djSP;
+#if defined(HAS_ACCESS) && defined(W_OK)
+ STRLEN n_a;
+ if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+ result = access(TOPpx, W_OK);
+ if (result == 0)
+ RETPUSHYES;
+ if (result < 0)
+ RETPUSHUNDEF;
+ RETPUSHNO;
+ }
+ else
+ result = my_stat(ARGS);
+#else
+ result = my_stat(ARGS);
+#endif
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IWUSR, 0, &PL_statcache))
PP(pp_ftrexec)
{
- I32 result = my_stat(ARGS);
+ I32 result;
djSP;
+#if defined(HAS_ACCESS) && defined(X_OK)
+ STRLEN n_a;
+ if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+ result = access(TOPpx, X_OK);
+ if (result == 0)
+ RETPUSHYES;
+ if (result < 0)
+ RETPUSHUNDEF;
+ RETPUSHNO;
+ }
+ else
+ result = my_stat(ARGS);
+#else
+ result = my_stat(ARGS);
+#endif
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IXUSR, 0, &PL_statcache))
PP(pp_fteread)
{
- I32 result = my_stat(ARGS);
+ I32 result;
djSP;
+#ifdef PERL_EFF_ACCESS_R_OK
+ STRLEN n_a;
+ if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+ result = PERL_EFF_ACCESS_R_OK(TOPpx);
+ if (result == 0)
+ RETPUSHYES;
+ if (result < 0)
+ RETPUSHUNDEF;
+ RETPUSHNO;
+ }
+ else
+ result = my_stat(ARGS);
+#else
+ result = my_stat(ARGS);
+#endif
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IRUSR, 1, &PL_statcache))
PP(pp_ftewrite)
{
- I32 result = my_stat(ARGS);
+ I32 result;
djSP;
+#ifdef PERL_EFF_ACCESS_W_OK
+ STRLEN n_a;
+ if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+ result = PERL_EFF_ACCESS_W_OK(TOPpx);
+ if (result == 0)
+ RETPUSHYES;
+ if (result < 0)
+ RETPUSHUNDEF;
+ RETPUSHNO;
+ }
+ else
+ result = my_stat(ARGS);
+#else
+ result = my_stat(ARGS);
+#endif
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IWUSR, 1, &PL_statcache))
PP(pp_fteexec)
{
- I32 result = my_stat(ARGS);
+ I32 result;
djSP;
+#ifdef PERL_EFF_ACCESS_X_OK
+ STRLEN n_a;
+ if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+ result = PERL_EFF_ACCESS_X_OK(TOPpx);
+ if (result == 0)
+ RETPUSHYES;
+ if (result < 0)
+ RETPUSHUNDEF;
+ RETPUSHNO;
+ }
+ else
+ result = my_stat(ARGS);
+#else
+ result = my_stat(ARGS);
+#endif
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IXUSR, 1, &PL_statcache))
int fd;
GV *gv;
char *tmps = Nullch;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP->op_gv;
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = (GV*)SvRV(POPs);
else
- gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
+ gv = gv_fetchpv(tmps = POPpx, FALSE, SVt_PVIO);
if (GvIO(gv) && IoIFP(GvIOp(gv)))
fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
register IO *io;
register SV *sv;
GV *gv;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP->op_gv;
really_filename:
PL_statgv = Nullgv;
PL_laststatval = -1;
- sv_setpv(PL_statname, SvPV(sv, PL_na));
+ sv_setpv(PL_statname, SvPV(sv, n_a));
#ifdef HAS_OPEN3
- i = PerlLIO_open3(SvPV(sv, PL_na), O_RDONLY, 0);
+ i = PerlLIO_open3(SvPV(sv, n_a), O_RDONLY, 0);
#else
- i = PerlLIO_open(SvPV(sv, PL_na), 0);
+ i = PerlLIO_open(SvPV(sv, n_a), 0);
#endif
if (i < 0) {
- if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, PL_na), '\n'))
- warner(WARN_NEWLINE, warn_nl, "open");
+ if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
+ warner(WARN_NEWLINE, PL_warn_nl, "open");
RETPUSHUNDEF;
}
PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
djSP; dTARGET;
char *tmps;
SV **svp;
+ STRLEN n_a;
if (MAXARG < 1)
tmps = Nullch;
else
- tmps = POPp;
+ tmps = POPpx;
if (!tmps || !*tmps) {
svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE);
if (svp)
- tmps = SvPV(*svp, PL_na);
+ tmps = SvPV(*svp, n_a);
}
if (!tmps || !*tmps) {
svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE);
if (svp)
- tmps = SvPV(*svp, PL_na);
+ tmps = SvPV(*svp, n_a);
}
#ifdef VMS
if (!tmps || !*tmps) {
svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
if (svp)
- tmps = SvPV(*svp, PL_na);
+ tmps = SvPV(*svp, n_a);
}
#endif
TAINT_PROPER("chdir");
PUSHi(value);
RETURN;
#else
- DIE(no_func, "Unsupported function chown");
+ DIE(PL_no_func, "Unsupported function chown");
#endif
}
djSP; dTARGET;
char *tmps;
#ifdef HAS_CHROOT
- tmps = POPp;
+ STRLEN n_a;
+ tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
RETURN;
#else
- DIE(no_func, "chroot");
+ DIE(PL_no_func, "chroot");
#endif
}
{
djSP; dTARGET;
int anum;
+ STRLEN n_a;
- char *tmps2 = POPp;
- char *tmps = SvPV(TOPs, PL_na);
+ char *tmps2 = POPpx;
+ char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("rename");
#ifdef HAS_RENAME
anum = PerlLIO_rename(tmps, tmps2);
{
djSP; dTARGET;
#ifdef HAS_LINK
- char *tmps2 = POPp;
- char *tmps = SvPV(TOPs, PL_na);
+ STRLEN n_a;
+ char *tmps2 = POPpx;
+ char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("link");
SETi( link(tmps, tmps2) >= 0 );
#else
- DIE(no_func, "Unsupported function link");
+ DIE(PL_no_func, "Unsupported function link");
#endif
RETURN;
}
{
djSP; dTARGET;
#ifdef HAS_SYMLINK
- char *tmps2 = POPp;
- char *tmps = SvPV(TOPs, PL_na);
+ STRLEN n_a;
+ char *tmps2 = POPpx;
+ char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("symlink");
SETi( symlink(tmps, tmps2) >= 0 );
RETURN;
#else
- DIE(no_func, "symlink");
+ DIE(PL_no_func, "symlink");
#endif
}
char *tmps;
char buf[MAXPATHLEN];
int len;
+ STRLEN n_a;
#ifndef INCOMPLETE_TAINTS
TAINT;
#endif
- tmps = POPp;
+ tmps = POPpx;
len = readlink(tmps, buf, sizeof buf);
EXTEND(SP, 1);
if (len < 0)
#ifndef HAS_MKDIR
int oldumask;
#endif
- char *tmps = SvPV(TOPs, PL_na);
+ STRLEN n_a;
+ char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("mkdir");
#ifdef HAS_MKDIR
{
djSP; dTARGET;
char *tmps;
+ STRLEN n_a;
- tmps = POPp;
+ tmps = POPpx;
TAINT_PROPER("rmdir");
#ifdef HAS_RMDIR
XPUSHi( PerlDir_rmdir(tmps) >= 0 );
{
djSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
- char *dirname = POPp;
+ STRLEN n_a;
+ char *dirname = POPpx;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
SETERRNO(EBADF,RMS$_DIR);
RETPUSHUNDEF;
#else
- DIE(no_dir_func, "opendir");
+ DIE(PL_no_dir_func, "opendir");
#endif
}
else
RETPUSHUNDEF;
#else
- DIE(no_dir_func, "readdir");
+ DIE(PL_no_dir_func, "readdir");
#endif
}
{
djSP; dTARGET;
#if defined(HAS_TELLDIR) || defined(telldir)
-# ifdef NEED_TELLDIR_PROTO /* XXX does _anyone_ need this? --AD 2/20/1998 */
+ /* XXX does _anyone_ need this? --AD 2/20/1998 */
+ /* XXX netbsd still seemed to.
+ XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style.
+ --JHI 1999-Feb-02 */
+# if !defined(HAS_TELLDIR_PROTO) || defined(NEED_TELLDIR_PROTO)
long telldir _((DIR *));
# endif
GV *gv = (GV*)POPs;
SETERRNO(EBADF,RMS$_ISI);
RETPUSHUNDEF;
#else
- DIE(no_dir_func, "telldir");
+ DIE(PL_no_dir_func, "telldir");
#endif
}
SETERRNO(EBADF,RMS$_ISI);
RETPUSHUNDEF;
#else
- DIE(no_dir_func, "seekdir");
+ DIE(PL_no_dir_func, "seekdir");
#endif
}
SETERRNO(EBADF,RMS$_ISI);
RETPUSHUNDEF;
#else
- DIE(no_dir_func, "rewinddir");
+ DIE(PL_no_dir_func, "rewinddir");
#endif
}
SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
#else
- DIE(no_dir_func, "closedir");
+ DIE(PL_no_dir_func, "closedir");
#endif
}
PUSHi(childpid);
RETURN;
#else
- DIE(no_func, "Unsupported function fork");
+ DIE(PL_no_func, "Unsupported function fork");
#endif
}
XPUSHi(childpid);
RETURN;
#else
- DIE(no_func, "Unsupported function wait");
+ DIE(PL_no_func, "Unsupported function wait");
#endif
}
SETi(childpid);
RETURN;
#else
- DIE(no_func, "Unsupported function waitpid");
+ DIE(PL_no_func, "Unsupported function waitpid");
#endif
}
int result;
int status;
Sigsave_t ihand,qhand; /* place to save signals during system() */
+ STRLEN n_a;
if (SP - MARK == 1) {
if (PL_tainting) {
- char *junk = SvPV(TOPs, PL_na);
+ char *junk = SvPV(TOPs, n_a);
TAINT_ENV();
TAINT_PROPER("system");
}
else if (SP - MARK != 1)
value = (I32)do_aexec(Nullsv, MARK, SP);
else {
- value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
+ value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
}
PerlProc__exit(-1);
#else /* ! FORK or VMS or OS/2 */
else if (SP - MARK != 1)
value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
else {
- value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), PL_na));
+ value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
}
STATUS_NATIVE_SET(value);
do_execfree();
{
djSP; dMARK; dORIGMARK; dTARGET;
I32 value;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
#ifdef VMS
value = (I32)vms_do_aexec(Nullsv, MARK, SP);
#else
+# ifdef __OPEN_VM
+ {
+ (void ) do_aspawn(Nullsv, MARK, SP);
+ value = 0;
+ }
+# else
value = (I32)do_aexec(Nullsv, MARK, SP);
+# endif
#endif
else {
if (PL_tainting) {
- char *junk = SvPV(*SP, PL_na);
+ char *junk = SvPV(*SP, n_a);
TAINT_ENV();
TAINT_PROPER("exec");
}
#ifdef VMS
- value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
+ value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
#else
- value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
+# ifdef __OPEN_VM
+ (void) do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
+ value = 0;
+# else
+ value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
+# endif
#endif
}
SP = ORIGMARK;
PUSHi(value);
RETURN;
#else
- DIE(no_func, "Unsupported function kill");
+ DIE(PL_no_func, "Unsupported function kill");
#endif
}
XPUSHi( getppid() );
RETURN;
#else
- DIE(no_func, "getppid");
+ DIE(PL_no_func, "getppid");
#endif
}
XPUSHi(value);
RETURN;
#else
- DIE(no_func, "getpgrp()");
+ DIE(PL_no_func, "getpgrp()");
#endif
}
#endif /* USE_BSDPGRP */
RETURN;
#else
- DIE(no_func, "setpgrp()");
+ DIE(PL_no_func, "setpgrp()");
#endif
}
SETi( getpriority(which, who) );
RETURN;
#else
- DIE(no_func, "getpriority()");
+ DIE(PL_no_func, "getpriority()");
#endif
}
SETi( setpriority(which, who, niceval) >= 0 );
RETURN;
#else
- DIE(no_func, "setpriority()");
+ DIE(PL_no_func, "setpriority()");
#endif
}
PUSHi((I32)anum);
RETURN;
#else
- DIE(no_func, "Unsupported function alarm");
+ DIE(PL_no_func, "Unsupported function alarm");
#endif
}
#ifdef HAS_GETHOSTBYNAME
return pp_ghostent(ARGS);
#else
- DIE(no_sock_func, "gethostbyname");
+ DIE(PL_no_sock_func, "gethostbyname");
#endif
}
#ifdef HAS_GETHOSTBYADDR
return pp_ghostent(ARGS);
#else
- DIE(no_sock_func, "gethostbyaddr");
+ DIE(PL_no_sock_func, "gethostbyaddr");
#endif
}
#endif
struct hostent *hent;
unsigned long len;
+ STRLEN n_a;
EXTEND(SP, 10);
if (which == OP_GHBYNAME)
#ifdef HAS_GETHOSTBYNAME
- hent = PerlSock_gethostbyname(POPp);
+ hent = PerlSock_gethostbyname(POPpx);
#else
- DIE(no_sock_func, "gethostbyname");
+ DIE(PL_no_sock_func, "gethostbyname");
#endif
else if (which == OP_GHBYADDR) {
#ifdef HAS_GETHOSTBYADDR
hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
#else
- DIE(no_sock_func, "gethostbyaddr");
+ DIE(PL_no_sock_func, "gethostbyaddr");
#endif
}
else
#ifdef HAS_GETHOSTENT
hent = PerlSock_gethostent();
#else
- DIE(no_sock_func, "gethostent");
+ DIE(PL_no_sock_func, "gethostent");
#endif
#ifdef HOST_NOT_FOUND
}
RETURN;
#else
- DIE(no_sock_func, "gethostent");
+ DIE(PL_no_sock_func, "gethostent");
#endif
}
#ifdef HAS_GETNETBYNAME
return pp_gnetent(ARGS);
#else
- DIE(no_sock_func, "getnetbyname");
+ DIE(PL_no_sock_func, "getnetbyname");
#endif
}
#ifdef HAS_GETNETBYADDR
return pp_gnetent(ARGS);
#else
- DIE(no_sock_func, "getnetbyaddr");
+ DIE(PL_no_sock_func, "getnetbyaddr");
#endif
}
struct netent *PerlSock_getnetent(void);
#endif
struct netent *nent;
+ STRLEN n_a;
if (which == OP_GNBYNAME)
#ifdef HAS_GETNETBYNAME
- nent = PerlSock_getnetbyname(POPp);
+ nent = PerlSock_getnetbyname(POPpx);
#else
- DIE(no_sock_func, "getnetbyname");
+ DIE(PL_no_sock_func, "getnetbyname");
#endif
else if (which == OP_GNBYADDR) {
#ifdef HAS_GETNETBYADDR
Netdb_net_t addr = (Netdb_net_t) U_L(POPn);
nent = PerlSock_getnetbyaddr(addr, addrtype);
#else
- DIE(no_sock_func, "getnetbyaddr");
+ DIE(PL_no_sock_func, "getnetbyaddr");
#endif
}
else
#ifdef HAS_GETNETENT
nent = PerlSock_getnetent();
#else
- DIE(no_sock_func, "getnetent");
+ DIE(PL_no_sock_func, "getnetent");
#endif
EXTEND(SP, 4);
RETURN;
#else
- DIE(no_sock_func, "getnetent");
+ DIE(PL_no_sock_func, "getnetent");
#endif
}
#ifdef HAS_GETPROTOBYNAME
return pp_gprotoent(ARGS);
#else
- DIE(no_sock_func, "getprotobyname");
+ DIE(PL_no_sock_func, "getprotobyname");
#endif
}
#ifdef HAS_GETPROTOBYNUMBER
return pp_gprotoent(ARGS);
#else
- DIE(no_sock_func, "getprotobynumber");
+ DIE(PL_no_sock_func, "getprotobynumber");
#endif
}
struct protoent *PerlSock_getprotoent(void);
#endif
struct protoent *pent;
+ STRLEN n_a;
if (which == OP_GPBYNAME)
#ifdef HAS_GETPROTOBYNAME
- pent = PerlSock_getprotobyname(POPp);
+ pent = PerlSock_getprotobyname(POPpx);
#else
- DIE(no_sock_func, "getprotobyname");
+ DIE(PL_no_sock_func, "getprotobyname");
#endif
else if (which == OP_GPBYNUMBER)
#ifdef HAS_GETPROTOBYNUMBER
pent = PerlSock_getprotobynumber(POPi);
#else
- DIE(no_sock_func, "getprotobynumber");
+ DIE(PL_no_sock_func, "getprotobynumber");
#endif
else
#ifdef HAS_GETPROTOENT
pent = PerlSock_getprotoent();
#else
- DIE(no_sock_func, "getprotoent");
+ DIE(PL_no_sock_func, "getprotoent");
#endif
EXTEND(SP, 3);
RETURN;
#else
- DIE(no_sock_func, "getprotoent");
+ DIE(PL_no_sock_func, "getprotoent");
#endif
}
#ifdef HAS_GETSERVBYNAME
return pp_gservent(ARGS);
#else
- DIE(no_sock_func, "getservbyname");
+ DIE(PL_no_sock_func, "getservbyname");
#endif
}
#ifdef HAS_GETSERVBYPORT
return pp_gservent(ARGS);
#else
- DIE(no_sock_func, "getservbyport");
+ DIE(PL_no_sock_func, "getservbyport");
#endif
}
struct servent *PerlSock_getservent(void);
#endif
struct servent *sent;
+ STRLEN n_a;
if (which == OP_GSBYNAME) {
#ifdef HAS_GETSERVBYNAME
- char *proto = POPp;
- char *name = POPp;
+ char *proto = POPpx;
+ char *name = POPpx;
if (proto && !*proto)
proto = Nullch;
sent = PerlSock_getservbyname(name, proto);
#else
- DIE(no_sock_func, "getservbyname");
+ DIE(PL_no_sock_func, "getservbyname");
#endif
}
else if (which == OP_GSBYPORT) {
#ifdef HAS_GETSERVBYPORT
- char *proto = POPp;
+ char *proto = POPpx;
unsigned short port = POPu;
#ifdef HAS_HTONS
#endif
sent = PerlSock_getservbyport(port, proto);
#else
- DIE(no_sock_func, "getservbyport");
+ DIE(PL_no_sock_func, "getservbyport");
#endif
}
else
#ifdef HAS_GETSERVENT
sent = PerlSock_getservent();
#else
- DIE(no_sock_func, "getservent");
+ DIE(PL_no_sock_func, "getservent");
#endif
EXTEND(SP, 4);
RETURN;
#else
- DIE(no_sock_func, "getservent");
+ DIE(PL_no_sock_func, "getservent");
#endif
}
PerlSock_sethostent(TOPi);
RETSETYES;
#else
- DIE(no_sock_func, "sethostent");
+ DIE(PL_no_sock_func, "sethostent");
#endif
}
PerlSock_setnetent(TOPi);
RETSETYES;
#else
- DIE(no_sock_func, "setnetent");
+ DIE(PL_no_sock_func, "setnetent");
#endif
}
PerlSock_setprotoent(TOPi);
RETSETYES;
#else
- DIE(no_sock_func, "setprotoent");
+ DIE(PL_no_sock_func, "setprotoent");
#endif
}
PerlSock_setservent(TOPi);
RETSETYES;
#else
- DIE(no_sock_func, "setservent");
+ DIE(PL_no_sock_func, "setservent");
#endif
}
EXTEND(SP,1);
RETPUSHYES;
#else
- DIE(no_sock_func, "endhostent");
+ DIE(PL_no_sock_func, "endhostent");
#endif
}
EXTEND(SP,1);
RETPUSHYES;
#else
- DIE(no_sock_func, "endnetent");
+ DIE(PL_no_sock_func, "endnetent");
#endif
}
EXTEND(SP,1);
RETPUSHYES;
#else
- DIE(no_sock_func, "endprotoent");
+ DIE(PL_no_sock_func, "endprotoent");
#endif
}
EXTEND(SP,1);
RETPUSHYES;
#else
- DIE(no_sock_func, "endservent");
+ DIE(PL_no_sock_func, "endservent");
#endif
}
#ifdef HAS_PASSWD
return pp_gpwent(ARGS);
#else
- DIE(no_func, "getpwnam");
+ DIE(PL_no_func, "getpwnam");
#endif
}
#ifdef HAS_PASSWD
return pp_gpwent(ARGS);
#else
- DIE(no_func, "getpwuid");
+ DIE(PL_no_func, "getpwuid");
#endif
}
I32 which = PL_op->op_type;
register SV *sv;
struct passwd *pwent;
+ STRLEN n_a;
if (which == OP_GPWNAM)
- pwent = getpwnam(POPp);
+ pwent = getpwnam(POPpx);
else if (which == OP_GPWUID)
pwent = getpwuid(POPi);
else
}
RETURN;
#else
- DIE(no_func, "getpwent");
+ DIE(PL_no_func, "getpwent");
#endif
}
setpwent();
RETPUSHYES;
#else
- DIE(no_func, "setpwent");
+ DIE(PL_no_func, "setpwent");
#endif
}
endpwent();
RETPUSHYES;
#else
- DIE(no_func, "endpwent");
+ DIE(PL_no_func, "endpwent");
#endif
}
#ifdef HAS_GROUP
return pp_ggrent(ARGS);
#else
- DIE(no_func, "getgrnam");
+ DIE(PL_no_func, "getgrnam");
#endif
}
#ifdef HAS_GROUP
return pp_ggrent(ARGS);
#else
- DIE(no_func, "getgrgid");
+ DIE(PL_no_func, "getgrgid");
#endif
}
register char **elem;
register SV *sv;
struct group *grent;
+ STRLEN n_a;
if (which == OP_GGRNAM)
- grent = (struct group *)getgrnam(POPp);
+ grent = (struct group *)getgrnam(POPpx);
else if (which == OP_GGRGID)
grent = (struct group *)getgrgid(POPi);
else
RETURN;
#else
- DIE(no_func, "getgrent");
+ DIE(PL_no_func, "getgrent");
#endif
}
setgrent();
RETPUSHYES;
#else
- DIE(no_func, "setgrent");
+ DIE(PL_no_func, "setgrent");
#endif
}
endgrent();
RETPUSHYES;
#else
- DIE(no_func, "endgrent");
+ DIE(PL_no_func, "endgrent");
#endif
}
PUSHp(tmps, strlen(tmps));
RETURN;
#else
- DIE(no_func, "getlogin");
+ DIE(PL_no_func, "getlogin");
#endif
}
register I32 i = 0;
I32 retval = -1;
MAGIC *mg;
+ STRLEN n_a;
if (PL_tainting) {
while (++MARK <= SP) {
else if (*MARK == &PL_sv_undef)
a[i++] = 0;
else
- a[i++] = (unsigned long)SvPV_force(*MARK, PL_na);
+ a[i++] = (unsigned long)SvPV_force(*MARK, n_a);
if (i > 15)
break;
}
PUSHi(retval);
RETURN;
#else
- DIE(no_func, "syscall");
+ DIE(PL_no_func, "syscall");
#endif
}
https://perl5.git.perl.org / perl5.git / blobdiff