summaryrefslogtreecommitdiff
path: root/pp_sys.c
diff options
context:
space:
mode:
Diffstat (limited to 'pp_sys.c')
-rw-r--r--pp_sys.c163
1 files changed, 100 insertions, 63 deletions
diff --git a/pp_sys.c b/pp_sys.c
index b3de2f8ef4..35d6f6f31b 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -298,7 +298,8 @@ PP(pp_backtick)
{
djSP; dTARGET;
PerlIO *fp;
- char *tmps = POPp;
+ STRLEN n_a;
+ char *tmps = POPpx;
I32 gimme = GIMME_V;
TAINT_PROPER("``");
@@ -384,7 +385,8 @@ PP(pp_glob)
#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
@@ -399,21 +401,22 @@ PP(pp_warn)
{
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";
@@ -427,15 +430,16 @@ PP(pp_die)
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;
@@ -465,7 +469,7 @@ PP(pp_die)
else {
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
- tmps = SvPV(error, PL_na);
+ tmps = SvPV(error, n_a);
}
}
if (!tmps || !*tmps)
@@ -660,6 +664,7 @@ PP(pp_tie)
char *methname;
int how = 'P';
U32 items;
+ STRLEN n_a;
varsv = *++MARK;
switch(SvTYPE(varsv)) {
@@ -696,7 +701,7 @@ PP(pp_tie)
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);
@@ -835,6 +840,7 @@ PP(pp_sselect)
struct timeval *tbuf = &timebuf;
I32 growsize;
char *fd_sets[4];
+ STRLEN n_a;
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
I32 masksize;
I32 offset;
@@ -903,7 +909,7 @@ PP(pp_sselect)
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);
@@ -1230,6 +1236,7 @@ PP(pp_prtf)
PerlIO *fp;
SV *sv;
MAGIC *mg;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
@@ -1260,7 +1267,7 @@ PP(pp_prtf)
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;
@@ -1270,10 +1277,10 @@ PP(pp_prtf)
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;
@@ -1643,11 +1650,12 @@ PP(pp_truncate)
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)) ||
@@ -1661,6 +1669,7 @@ PP(pp_truncate)
else {
SV *sv = POPs;
char *name;
+ STRLEN n_a;
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv; /* *main::FRED for example */
@@ -1671,7 +1680,7 @@ PP(pp_truncate)
goto do_ftruncate;
}
- name = SvPV(sv, PL_na);
+ name = SvPV(sv, n_a);
TAINT_PROPER("truncate");
#ifdef HAS_TRUNCATE
if (truncate(name, len) < 0)
@@ -2149,8 +2158,9 @@ PP(pp_ssockopt)
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);
@@ -2263,6 +2273,7 @@ PP(pp_stat)
GV *tmpgv;
I32 gimme;
I32 max = 13;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
tmpgv = cGVOP->op_gv;
@@ -2287,17 +2298,17 @@ PP(pp_stat)
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'))
+ if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
warner(WARN_NEWLINE, PL_warn_nl, "stat");
max = 0;
}
@@ -2349,8 +2360,9 @@ PP(pp_ftrread)
I32 result;
djSP;
#if defined(HAS_ACCESS) && defined(R_OK)
+ STRLEN n_a;
if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
- result = access(TOPp, R_OK);
+ result = access(TOPpx, R_OK);
if (result == 0)
RETPUSHYES;
if (result < 0)
@@ -2375,8 +2387,9 @@ PP(pp_ftrwrite)
I32 result;
djSP;
#if defined(HAS_ACCESS) && defined(W_OK)
+ STRLEN n_a;
if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
- result = access(TOPp, W_OK);
+ result = access(TOPpx, W_OK);
if (result == 0)
RETPUSHYES;
if (result < 0)
@@ -2401,8 +2414,9 @@ PP(pp_ftrexec)
I32 result;
djSP;
#if defined(HAS_ACCESS) && defined(X_OK)
+ STRLEN n_a;
if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
- result = access(TOPp, X_OK);
+ result = access(TOPpx, X_OK);
if (result == 0)
RETPUSHYES;
if (result < 0)
@@ -2427,8 +2441,9 @@ PP(pp_fteread)
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(TOPp);
+ result = PERL_EFF_ACCESS_R_OK(TOPpx);
if (result == 0)
RETPUSHYES;
if (result < 0)
@@ -2453,8 +2468,9 @@ PP(pp_ftewrite)
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(TOPp);
+ result = PERL_EFF_ACCESS_W_OK(TOPpx);
if (result == 0)
RETPUSHYES;
if (result < 0)
@@ -2479,8 +2495,9 @@ PP(pp_fteexec)
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(TOPp);
+ result = PERL_EFF_ACCESS_X_OK(TOPpx);
if (result == 0)
RETPUSHYES;
if (result < 0)
@@ -2701,6 +2718,7 @@ PP(pp_fttty)
int fd;
GV *gv;
char *tmps = Nullch;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP->op_gv;
@@ -2709,7 +2727,7 @@ PP(pp_fttty)
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)));
@@ -2741,6 +2759,7 @@ PP(pp_fttext)
register IO *io;
register SV *sv;
GV *gv;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP->op_gv;
@@ -2804,14 +2823,14 @@ PP(pp_fttext)
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'))
+ if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
warner(WARN_NEWLINE, PL_warn_nl, "open");
RETPUSHUNDEF;
}
@@ -2867,26 +2886,27 @@ PP(pp_chdir)
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");
@@ -2918,7 +2938,8 @@ PP(pp_chroot)
djSP; dTARGET;
char *tmps;
#ifdef HAS_CHROOT
- tmps = POPp;
+ STRLEN n_a;
+ tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
RETURN;
@@ -2961,9 +2982,10 @@ PP(pp_rename)
{
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);
@@ -2987,8 +3009,9 @@ PP(pp_link)
{
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
@@ -3001,8 +3024,9 @@ PP(pp_symlink)
{
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;
@@ -3018,11 +3042,12 @@ PP(pp_readlink)
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)
@@ -3131,7 +3156,8 @@ PP(pp_mkdir)
#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
@@ -3149,8 +3175,9 @@ PP(pp_rmdir)
{
djSP; dTARGET;
char *tmps;
+ STRLEN n_a;
- tmps = POPp;
+ tmps = POPpx;
TAINT_PROPER("rmdir");
#ifdef HAS_RMDIR
XPUSHi( PerlDir_rmdir(tmps) >= 0 );
@@ -3166,7 +3193,8 @@ PP(pp_open_dir)
{
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);
@@ -3411,10 +3439,11 @@ PP(pp_system)
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");
}
@@ -3450,7 +3479,7 @@ PP(pp_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 */
@@ -3461,7 +3490,7 @@ PP(pp_system)
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();
@@ -3475,6 +3504,7 @@ PP(pp_exec)
{
djSP; dMARK; dORIGMARK; dTARGET;
I32 value;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
@@ -3495,18 +3525,18 @@ PP(pp_exec)
#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
# ifdef __OPEN_VM
- (void) do_spawn(SvPVx(sv_mortalcopy(*SP), PL_na));
+ (void) do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
value = 0;
# else
- value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
+ value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
# endif
#endif
}
@@ -3930,11 +3960,12 @@ PP(pp_ghostent)
#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(PL_no_sock_func, "gethostbyname");
#endif
@@ -4037,10 +4068,11 @@ PP(pp_gnetent)
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(PL_no_sock_func, "getnetbyname");
#endif
@@ -4124,10 +4156,11 @@ PP(pp_gprotoent)
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(PL_no_sock_func, "getprotobyname");
#endif
@@ -4206,11 +4239,12 @@ PP(pp_gservent)
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;
@@ -4222,7 +4256,7 @@ PP(pp_gservent)
}
else if (which == OP_GSBYPORT) {
#ifdef HAS_GETSERVBYPORT
- char *proto = POPp;
+ char *proto = POPpx;
unsigned short port = POPu;
#ifdef HAS_HTONS
@@ -4399,9 +4433,10 @@ PP(pp_gpwent)
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
@@ -4532,9 +4567,10 @@ PP(pp_ggrent)
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
@@ -4626,6 +4662,7 @@ PP(pp_syscall)
register I32 i = 0;
I32 retval = -1;
MAGIC *mg;
+ STRLEN n_a;
if (PL_tainting) {
while (++MARK <= SP) {
@@ -4648,7 +4685,7 @@ PP(pp_syscall)
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;
}
View Lorry Controller Status