#ifdef XS_VERSION
# define XS_VERSION_BOOTCHECK \
STMT_START { \
- SV *tmpsv; \
- char *vn = Nullch, *module = SvPV(ST(0),PL_na); \
+ SV *tmpsv; STRLEN n_a; \
+ char *vn = Nullch, *module = SvPV(ST(0),n_a); \
if (items >= 2) /* version supplied as bootstrap arg */ \
tmpsv = ST(1); \
else { \
tmpsv = perl_get_sv(form("%s::%s", module, \
vn = "VERSION"), FALSE); \
} \
- if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, PL_na)))) \
+ if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a)))) \
croak("%s object version %s does not match %s%s%s%s %_", \
module, XS_VERSION, \
vn ? "$" : "", vn ? module : "", vn ? "::" : "", \
dTHR;
int rc;
char **a,*tmps,**argv;
+ STRLEN n_a;
if (sp<=mark)
return -1;
while (++mark <= sp)
if (*mark)
- *a++ = SvPVx(*mark, PL_na);
+ *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
*a = Nullch;
) /* will swawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
- if (really && *(tmps = SvPV(really, PL_na)))
+ if (really && *(tmps = SvPV(really, n_a)))
rc=spawnvp (P_WAIT,tmps,argv);
else
rc=spawnvp (P_WAIT,argv[0],argv);
}
else
PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",
- SvPV(sv, PL_na), Strerror(errno));
+ SvPV(sv, oldlen), Strerror(errno));
}
if (PL_inplace) {
(void)do_close(PL_argvoutgv,FALSE);
else {
SV* sv = POPs;
char *s;
+ STRLEN n_a;
PUTBACK;
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv;
goto do_fstat;
}
- s = SvPV(sv, PL_na);
+ s = SvPV(sv, n_a);
PL_statgv = Nullgv;
sv_setpv(PL_statname, s);
PL_laststype = OP_STAT;
{
djSP;
SV *sv;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
EXTEND(SP,1);
if (cGVOP->op_gv == PL_defgv) {
PL_statgv = Nullgv;
sv = POPs;
PUTBACK;
- sv_setpv(PL_statname,SvPV(sv, PL_na));
+ sv_setpv(PL_statname,SvPV(sv, n_a));
#ifdef HAS_LSTAT
- PL_laststatval = PerlLIO_lstat(SvPV(sv, PL_na),&PL_statcache);
+ PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
#else
- PL_laststatval = PerlLIO_stat(SvPV(sv, PL_na),&PL_statcache);
+ PL_laststatval = PerlLIO_stat(SvPV(sv, n_a),&PL_statcache);
#endif
- if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, PL_na), '\n'))
+ if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
warner(WARN_NEWLINE, PL_warn_nl, "lstat");
return PL_laststatval;
}
{
register char **a;
char *tmps;
+ STRLEN n_a;
if (sp > mark) {
dTHR;
a = PL_Argv;
while (++mark <= sp) {
if (*mark)
- *a++ = SvPVx(*mark, PL_na);
+ *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
}
*a = Nullch;
if (*PL_Argv[0] != '/') /* will execvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
- if (really && *(tmps = SvPV(really, PL_na)))
+ if (really && *(tmps = SvPV(really, n_a)))
PerlProc_execvp(tmps,PL_Argv);
else
PerlProc_execvp(PL_Argv[0],PL_Argv);
char *what;
char *s;
SV **oldmark = mark;
+ STRLEN n_a;
#define APPLY_TAINT_PROPER() \
STMT_START { \
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
- char *name = SvPVx(*mark, PL_na);
+ char *name = SvPVx(*mark, n_a);
APPLY_TAINT_PROPER();
if (PerlLIO_chmod(name, val))
tot--;
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
- char *name = SvPVx(*mark, PL_na);
+ char *name = SvPVx(*mark, n_a);
APPLY_TAINT_PROPER();
if (PerlLIO_chown(name, val, val2))
tot--;
APPLY_TAINT_PROPER();
if (mark == sp)
break;
- s = SvPVx(*++mark, PL_na);
+ s = SvPVx(*++mark, n_a);
if (isUPPER(*s)) {
if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
s += 3;
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
- s = SvPVx(*mark, PL_na);
+ s = SvPVx(*mark, n_a);
APPLY_TAINT_PROPER();
if (PL_euid || PL_unsafe) {
if (UNLINK(s))
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
- char *name = SvPVx(*mark, PL_na);
+ char *name = SvPVx(*mark, n_a);
APPLY_TAINT_PROPER();
if (PerlLIO_utime(name, &utbuf))
tot--;
len = leftlen < rightlen ? leftlen : rightlen;
lensave = len;
if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
- dc = SvPV_force(sv, PL_na);
+ STRLEN n_a;
+ dc = SvPV_force(sv, n_a);
if (SvCUR(sv) < len) {
dc = SvGROW(sv, len + 1);
(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
sv_peek(SV *sv)
{
SV *t = sv_newmortal();
- STRLEN prevlen;
+ STRLEN n_a;
int unref = 0;
sv_setpvn(t, "", 0);
while (unref--)
sv_catpv(t, ")");
}
- return SvPV(t, PL_na);
+ return SvPV(t, n_a);
}
void
do_op_dump(I32 level, PerlIO *file, OP *o)
{
dTHR;
+ STRLEN n_a;
dump_indent(level, file, "{\n");
level++;
if (o->op_seq)
ENTER;
SAVEFREESV(tmpsv);
gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch);
- dump_indent(level, file, "GV = %s\n", SvPV(tmpsv, PL_na));
+ dump_indent(level, file, "GV = %s\n", SvPV(tmpsv, n_a));
LEAVE;
}
else
char *s;
U32 flags;
U32 type;
+ STRLEN n_a;
if (!sv) {
dump_indent(level, file, "SV = 0\n");
break;
case SVt_PVCV:
if (SvPOK(sv))
- dump_indent(level, file, " PROTOTYPE = \"%s\"\n", SvPV(sv,PL_na));
+ dump_indent(level, file, " PROTOTYPE = \"%s\"\n", SvPV(sv,n_a));
/* FALL THROUGH */
case SVt_PVFM:
do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
cchar(SV *sv)
{
SV *sstr = newSVpv("'", 0);
- char *s = SvPV(sv, PL_na);
+ STRLEN n_a;
+ char *s = SvPV(sv, n_a);
if (*s == '\'')
sv_catpv(sstr, "\\'");
DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
void * openinfo = NULL ;
INFO * info = &RETVAL->info ;
+ STRLEN n_a;
/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
Zero(RETVAL, 1, DB_File_type) ;
#endif
svp = hv_fetch(action, "bfname", 6, FALSE);
if (svp && SvOK(*svp)) {
- char * ptr = SvPV(*svp,PL_na) ;
+ char * ptr = SvPV(*svp,n_a) ;
#ifdef DB_VERSION_MAJOR
- name = (char*) PL_na ? ptr : NULL ;
+ name = (char*) n_a ? ptr : NULL ;
#else
- info->db_RE_bfname = (char*) (PL_na ? ptr : NULL) ;
+ info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
#endif
}
else
{
int value ;
if (SvPOK(*svp))
- value = (int)*SvPV(*svp, PL_na) ;
+ value = (int)*SvPV(*svp, n_a) ;
else
value = SvIV(*svp) ;
if (svp && SvOK(*svp))
{
if (SvPOK(*svp))
- info->db_RE_bval = (u_char)*SvPV(*svp, PL_na) ;
+ info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
else
info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
DB_flags(info->flags, DB_DELIMITER) ;
{
char * name = (char *) NULL ;
SV * sv = (SV *) NULL ;
+ STRLEN n_a;
if (items >= 3 && SvOK(ST(2)))
- name = (char*) SvPV(ST(2), PL_na) ;
+ name = (char*) SvPV(ST(2), n_a) ;
if (items == 6)
sv = ST(5) ;
int i ;
int One ;
DB * Db = db->dbp ;
+ STRLEN n_a;
DBT_flags(key) ;
DBT_flags(value) ;
#endif
for (i = items-1 ; i > 0 ; --i)
{
- value.data = SvPV(ST(i), PL_na) ;
- value.size = PL_na ;
+ value.data = SvPV(ST(i), n_a) ;
+ value.size = n_a ;
One = 1 ;
key.data = &One ;
key.size = sizeof(int) ;
DBT value ;
DB * Db = db->dbp ;
int i ;
+ STRLEN n_a;
DBT_flags(key) ;
DBT_flags(value) ;
{
++ (* (int*)key.data) ;
- value.data = SvPV(ST(i), PL_na) ;
- value.size = PL_na ;
+ value.data = SvPV(ST(i), n_a) ;
+ value.size = n_a ;
RETVAL = (Db->put)(Db, NULL, &key, &value, 0) ;
if (RETVAL != 0)
break;
#else
for (i = items - 1 ; i > 0 ; --i)
{
- value.data = SvPV(ST(i), PL_na) ;
- value.size = PL_na ;
+ value.data = SvPV(ST(i), n_a) ;
+ value.size = n_a ;
RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
if (RETVAL != 0)
break;
I32 i, psize;
char *result;
char **p;
+ STRLEN n_a;
/* Do not load what is already loaded into this process */
if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
p = (char **) safemalloc(psize * sizeof(char*));
p[0] = path;
for(i=1; i<psize-1; i++) {
- p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), PL_na);
+ p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), n_a);
}
p[psize-1] = 0;
rld_success = rld_load(nxerr, (struct mach_header **)0, p,
}
else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) {
int b, j;
- char *bitmap = SvPV(bitspec,PL_na);
+ STRLEN n_a;
+ char *bitmap = SvPV(bitspec,n_a);
myopcode = 0;
for (b=0; b < opset_len; b++) {
U16 bits = bitmap[b];
PL_sig_name[sig],
strlen(PL_sig_name[sig]),
TRUE);
+ STRLEN n_a;
/* Remember old handler name if desired. */
if (oldaction) {
- char *hand = SvPVx(*sigsvp, PL_na);
+ char *hand = SvPVx(*sigsvp, n_a);
svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
sv_setpv(*svp, *hand ? hand : "DEFAULT");
}
svp = hv_fetch(action, "HANDLER", 7, FALSE);
if (!svp)
croak("Can't supply an action without a HANDLER");
- sv_setpv(*sigsvp, SvPV(*svp, PL_na));
+ sv_setpv(*sigsvp, SvPV(*svp, n_a));
mg_set(*sigsvp); /* handles DEFAULT and IGNORE */
act.sa_handler = sighandler;
for (i = 1; i <= AvFILL(av); i++)
XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
} else {
- char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na);
+ STRLEN n_a;
+ char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a);
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"%p: join propagating die message: %s\n",
thr, mess));
if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv)))
croak("can't set attributes outside a subroutine scope");
for (i = 1; i < items; i++) {
- char *attr = SvPV(ST(i), PL_na);
+ STRLEN n_a;
+ char *attr = SvPV(ST(i), n_a);
cv_flags_t flag = get_flag(attr);
if (!flag)
croak("invalid attribute name %s", attr);
sub = Nullsv;
}
else {
- char *name = SvPV(sub, PL_na);
+ STRLEN n_a;
+ char *name = SvPV(sub, n_a);
sub = (SV*)perl_get_cv(name, FALSE);
}
if (!sub)
MAGIC* mg=mg_find((SV*)stash,'c');
AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
AMT amt;
+ STRLEN n_a;
if (mg && amtp->was_ok_am == PL_amagic_generation
&& amtp->was_ok_sub == PL_sub_generation)
default:
if (!SvROK(sv)) {
if (!SvOK(sv)) break;
- gv = gv_fetchmethod(stash, SvPV(sv, PL_na));
+ gv = gv_fetchmethod(stash, SvPV(sv, n_a));
if (gv) cv = GvCV(gv);
break;
}
GV *ngv;
DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
- SvPV(GvSV(gv), PL_na), cp, HvNAME(stash)) );
+ SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) );
if (!SvPOK(GvSV(gv))
|| !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
FALSE)))
SV *sv;
char *pv;
int have = 0;
+ STRLEN n_a;
if (emergency_buffer_size) {
add_to_chain(emergency_buffer, emergency_buffer_size, 0);
return (char *)-1; /* Now die die die... */
}
/* Got it, now detach SvPV: */
- pv = SvPV(sv, PL_na);
+ pv = SvPV(sv, n_a);
/* Check alignment: */
if (((UV)(pv - sizeof(union overhead))) & ((1<<LOG_OF_MIN_ARENA) - 1)) {
PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
return (STRLEN)PL_orslen;
}
magic_get(sv,mg);
- if (!SvPOK(sv) && SvNIOK(sv))
- sv_2pv(sv, &PL_na);
+ if (!SvPOK(sv) && SvNIOK(sv)) {
+ STRLEN n_a;
+ sv_2pv(sv, &n_a);
+ }
if (SvPOK(sv))
return SvCUR(sv);
return 0;
int
magic_clearenv(SV *sv, MAGIC *mg)
{
- my_setenv(MgPV(mg,PL_na),Nullch);
+ STRLEN n_a;
+ my_setenv(MgPV(mg,n_a),Nullch);
return 0;
}
dTHR;
if (PL_localizing) {
HE* entry;
+ STRLEN n_a;
magic_clear_all_env(sv,mg);
hv_iterinit((HV*)sv);
while (entry = hv_iternext((HV*)sv)) {
I32 keylen;
my_setenv(hv_iterkey(entry, &keylen),
- SvPV(hv_iterval((HV*)sv, entry), PL_na));
+ SvPV(hv_iterval((HV*)sv, entry), n_a));
}
}
#endif
magic_getsig(SV *sv, MAGIC *mg)
{
I32 i;
+ STRLEN n_a;
/* Are we fetching a signal entry? */
- i = whichsig(MgPV(mg,PL_na));
+ i = whichsig(MgPV(mg,n_a));
if (i) {
if(PL_psig_ptr[i])
sv_setsv(sv,PL_psig_ptr[i]);
magic_clearsig(SV *sv, MAGIC *mg)
{
I32 i;
+ STRLEN n_a;
/* Are we clearing a signal entry? */
- i = whichsig(MgPV(mg,PL_na));
+ i = whichsig(MgPV(mg,n_a));
if (i) {
if(PL_psig_ptr[i]) {
SvREFCNT_dec(PL_psig_ptr[i]);
I32 i;
GV* gv;
SV** svp;
+ STRLEN n_a;
gv = PL_DBline;
i = SvTRUE(sv);
svp = av_fetch(GvAV(gv),
- atoi(MgPV(mg,PL_na)), FALSE);
+ atoi(MgPV(mg,n_a)), FALSE);
if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
o->op_private = i;
else
{
register char *s;
GV* gv;
+ STRLEN n_a;
if (!SvOK(sv))
return 0;
- s = SvPV(sv, PL_na);
+ s = SvPV(sv, n_a);
if (*s == '*' && s[1])
s++;
gv = gv_fetchpv(s,TRUE, SVt_PVGV);
return;
if (mg->mg_obj) {
SV *ahv = LvTARG(sv);
+ STRLEN n_a;
if (SvTYPE(ahv) == SVt_PVHV) {
HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0);
if (he)
value = *svp;
}
if (!value || value == &PL_sv_undef)
- croak(PL_no_helem, SvPV(mg->mg_obj, PL_na));
+ croak(PL_no_helem, SvPV(mg->mg_obj, n_a));
}
else {
AV* av = (AV*)LvTARG(sv);
if (PL_inplace)
Safefree(PL_inplace);
if (SvOK(sv))
- PL_inplace = savepv(SvPV(sv,PL_na));
+ PL_inplace = savepv(SvPV(sv,len));
else
PL_inplace = Nullch;
break;
if (PL_osname)
Safefree(PL_osname);
if (SvOK(sv))
- PL_osname = savepv(SvPV(sv,PL_na));
+ PL_osname = savepv(SvPV(sv,len));
else
PL_osname = Nullch;
break;
break;
case '^':
Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
- IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na));
+ IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '~':
Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
- IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na));
+ IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '=':
case '#':
if (PL_ofmt)
Safefree(PL_ofmt);
- PL_ofmt = savepv(SvPV(sv,PL_na));
+ PL_ofmt = savepv(SvPV(sv,len));
break;
case '[':
PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
case ')':
#ifdef HAS_SETGROUPS
{
- char *p = SvPV(sv, PL_na);
+ char *p = SvPV(sv, len);
Groups_t gary[NGROUPS];
SET_NUMERIC_STANDARD();
PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case ':':
- PL_chopset = SvPV_force(sv,PL_na);
+ PL_chopset = SvPV_force(sv,len);
break;
case '0':
if (!PL_origalen) {
STATIC char*
gv_ename(GV *gv)
{
+ STRLEN n_a;
SV* tmpsv = sv_newmortal();
gv_efullname3(tmpsv, gv, Nullch);
- return SvPV(tmpsv,PL_na);
+ return SvPV(tmpsv,n_a);
}
STATIC OP *
if (!p)
return NOT_IN_PAD;
key = p - PL_threadsv_names;
+ MUTEX_LOCK(&thr->mutex);
svp = av_fetch(thr->threadsv, key, FALSE);
- if (!svp) {
+ if (svp)
+ MUTEX_UNLOCK(&thr->mutex);
+ else {
SV *sv = NEWSV(0, 0);
av_store(thr->threadsv, key, sv);
thr->threadsvp = AvARRAY(thr->threadsv);
+ MUTEX_UNLOCK(&thr->mutex);
/*
* Some magic variables used to be automagically initialised
* in gv_fetchpv. Those which are now per-thread magicals get
dTHR;
OP *kid;
SV *sv;
+ STRLEN n_a;
if (!o || PL_error_count)
return o;
PL_modcount++;
if (!type)
croak("Can't localize lexical variable %s",
- SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), PL_na));
+ SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a));
break;
#ifdef USE_THREADS
{
dTHR;
OP *o;
+ STRLEN n_a;
+
if (type != OP_GOTO || label->op_type == OP_CONST) {
/* "last()" means "last" */
if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
o = newOP(type, OPf_SPECIAL);
else {
o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
- ? SvPVx(((SVOP*)label)->op_sv, PL_na)
+ ? SvPVx(((SVOP*)label)->op_sv, n_a)
: ""));
}
op_free(label);
newSUB(I32 floor, OP *o, OP *proto, OP *block)
{
dTHR;
- char *name = o ? SvPVx(cSVOPo->op_sv, PL_na) : Nullch;
+ STRLEN n_a;
+ char *name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
GV *gv = gv_fetchpv(name ? name : "__ANON__",
GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
- char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, PL_na) : Nullch;
+ char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
register CV *cv=0;
I32 ix;
else {
/* force display of errors found but not reported */
sv_catpv(ERRSV, not_safe);
- croak("%s", SvPVx(ERRSV, PL_na));
+ croak("%s", SvPVx(ERRSV, n_a));
}
}
}
char *name;
GV *gv;
I32 ix;
+ STRLEN n_a;
if (o)
- name = SvPVx(cSVOPo->op_sv, PL_na);
+ name = SvPVx(cSVOPo->op_sv, n_a);
else
name = "STDOUT";
gv = gv_fetchpv(name,TRUE, SVt_PVFM);
int iscv;
GV *gv;
SV *kidsv = kid->op_sv;
+ STRLEN n_a;
/* Is it a constant from cv_const_sv()? */
if (SvROK(kidsv) && SvREADONLY(kidsv)) {
croak("Constant is not %s reference", badtype);
return o;
}
- name = SvPV(kidsv, PL_na);
+ name = SvPV(kidsv, n_a);
if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
char *badthing = Nullch;
switch (o->op_type) {
SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+ STRLEN n_a;
OP *newop = newGVOP(type, OPf_REF,
- gv_fetchpv(SvPVx(kid->op_sv, PL_na), TRUE, SVt_PVIO));
+ gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
op_free(o);
return newop;
}
}
if (o->op_flags & OPf_KIDS) {
+ STRLEN n_a;
tokid = &cLISTOPo->op_first;
kid = cLISTOPo->op_first;
if (kid->op_type == OP_PUSHMARK ||
case OA_AVREF:
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
- char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
+ char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newAVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVAV) ));
if (ckWARN(WARN_SYNTAX))
case OA_HVREF:
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
- char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
+ char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newHVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVHV) ));
if (ckWARN(WARN_SYNTAX))
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
OP *newop = newGVOP(OP_GV, 0,
- gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, PL_na), TRUE,
+ gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
SVt_PVIO) );
op_free(kid);
kid = newop;
GV *namegv = 0;
int optional = 0;
I32 arg = 0;
+ STRLEN n_a;
for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
if (cvop->op_type == OP_RV2CV) {
cv = GvCVu(tmpop->op_sv);
if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
- proto = SvPV((SV*)cv, PL_na);
+ proto = SvPV((SV*)cv, n_a);
}
}
}
default:
oops:
croak("Malformed prototype for %s: %s",
- gv_ename(namegv), SvPV((SV*)cv, PL_na));
+ gv_ename(namegv), SvPV((SV*)cv, n_a));
}
}
else
{
dTHR;
register OP* oldop = 0;
+ STRLEN n_a;
+
if (!o || o->op_seq)
return;
ENTER;
indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
if (!indsvp) {
croak("No such field \"%s\" in variable %s of type %s",
- key, SvPV(lexname, PL_na), HvNAME(SvSTASH(lexname)));
+ key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
}
ind = SvIV(*indsvp);
if (ind < 1)
}
if (rc || SvTRUE(GvSV(PL_errgv))) {
if (SvTRUE(GvSV(PL_errgv))) {
- die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), PL_na)) ;
+ STRLEN n_a;
+ die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), n_a)) ;
}
die ("REXX compartment returned non-zero status %li", rc);
}
os2_cond_wait(perl_cond *c, perl_mutex *m)
{
int rc;
- if ((rc = DosResetEventSem(*c,&PL_na)) && (rc != ERROR_ALREADY_RESET))
+ STRLEN n_a;
+ if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET))
croak("panic: COND_WAIT-reset: rc=%i", rc);
if (m) MUTEX_UNLOCK(m);
if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
char **argsp = fargs;
char nargs = 4;
int force_shell;
+ STRLEN n_a;
if (flag == P_WAIT)
flag = P_NOWAIT;
) /* will spawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
/* We should check PERL_SH* and PERLLIB_* as well? */
- if (!really || !*(tmps = SvPV(really, PL_na)))
+ if (!really || !*(tmps = SvPV(really, n_a)))
tmps = PL_Argv[0];
reread:
char *tmps = NULL;
int rc;
int flag = P_WAIT, trueflag, err, secondtry = 0;
+ STRLEN n_a;
if (sp > mark) {
New(1301,PL_Argv, sp - mark + 3, char*);
while (++mark <= sp) {
if (*mark)
- *a++ = SvPVx(*mark, PL_na);
+ *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
}
if (items < 2 || items > 3)
croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
{
- char * src = (char *)SvPV(ST(0),PL_na);
- char * dst = (char *)SvPV(ST(1),PL_na);
+ STRLEN n_a;
+ char * src = (char *)SvPV(ST(0),n_a);
+ char * dst = (char *)SvPV(ST(1),n_a);
U32 flag;
int RETVAL, rc;
AV *av;
SV *svp;
char *s;
+ STRLEN n_a;
if (!SvROK(sv)) croak("Not a reference given to mod2fname");
sv = SvRV(sv);
if (avlen < 0)
croak("Empty array reference given to mod2fname");
- s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
+ s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
strncpy(fname, s, 8);
len = strlen(s);
if (len < 6) pos = len;
}
avlen --;
while (avlen >= 0) {
- s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
+ s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
while (*s) {
sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */
}
if (items != 1)
croak("Usage: OS2::Errors2Drive(drive)");
{
+ STRLEN n_a;
SV *sv = ST(0);
int suppress = SvOK(sv);
- char *s = suppress ? SvPV(sv, PL_na) : NULL;
+ char *s = suppress ? SvPV(sv, n_a) : NULL;
char drive = (s ? *s : 0);
unsigned long rc;
if (items != 1)
croak("Usage: Cwd::sys_chdir(path)");
{
- char * path = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_chdir(path);
if (items != 1)
croak("Usage: Cwd::change_drive(d)");
{
- char d = (char)*SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char d = (char)*SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = change_drive(d);
if (items != 1)
croak("Usage: Cwd::sys_is_absolute(path)");
{
- char * path = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_absolute(path);
if (items != 1)
croak("Usage: Cwd::sys_is_rooted(path)");
{
- char * path = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_rooted(path);
if (items != 1)
croak("Usage: Cwd::sys_is_relative(path)");
{
- char * path = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_relative(path);
if (items < 1 || items > 2)
croak("Usage: Cwd::sys_abspath(path, dir = NULL)");
{
- char * path = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * path = (char *)SvPV(ST(0),n_a);
char * dir;
char p[MAXPATHLEN];
char * RETVAL;
if (items < 2)
dir = NULL;
else {
- dir = (char *)SvPV(ST(1),PL_na);
+ dir = (char *)SvPV(ST(1),n_a);
}
if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) {
path += 2;
if (items < 1 || items > 2)
croak("Usage: Cwd::extLibpath_set(s, type = 0)");
{
- char * s = (char *)SvPV(ST(0),PL_na);
+ STRLEN n_a;
+ char * s = (char *)SvPV(ST(0),n_a);
bool type;
U32 rc;
bool RETVAL;
sv = POPs;
PUTBACK;
- if (croak_on_error && SvTRUE(ERRSV))
- croak(SvPVx(ERRSV, PL_na));
+ if (croak_on_error && SvTRUE(ERRSV)) {
+ STRLEN n_a;
+ croak(SvPVx(ERRSV, n_a));
+ }
return sv;
}
croak("Can't stat script \"%s\"",PL_origfilename);
if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
I32 len;
+ STRLEN n_a;
#ifdef IAMSUID
#ifndef HAS_SETREUID
PL_doswitches = FALSE; /* -s is insecure in suid */
PL_curcop->cop_line++;
if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
- strnNE(SvPV(PL_linestr,PL_na),"#!",2) ) /* required even on Sys V */
+ strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */
croak("No #! line");
- s = SvPV(PL_linestr,PL_na)+2;
+ s = SvPV(PL_linestr,n_a)+2;
if (*s == ' ') s++;
while (!isSPACE(*s)) s++;
- for (s2 = s; (s2 > SvPV(PL_linestr,PL_na)+2 &&
+ for (s2 = s; (s2 > SvPV(PL_linestr,n_a)+2 &&
(isDIGIT(s2[-1]) || strchr("._-", s2[-1]))); s2--) ;
if (strnNE(s2-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */
croak("Not a perl script");
char *unix;
STRLEN len;
- if ((unix = tounixspec_ts(SvPV(libdir,PL_na),Nullch)) != Nullch) {
+ if ((unix = tounixspec_ts(SvPV(libdir,len),Nullch)) != Nullch) {
len = strlen(unix);
while (unix[len-1] == '/') len--; /* Cosmetic */
sv_usepvn(libdir,unix,len);
else
PerlIO_printf(PerlIO_stderr(),
"Failed to unixify @INC element \"%s\"\n",
- SvPV(libdir,PL_na));
+ SvPV(libdir,len));
#endif
/* .../archname/version if -d .../archname/version/auto */
sv_setsv(subdir, libdir);
break;
case 57:
#line 302 "perly.y"
-{ char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na);
+{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
|| strEQ(name, "INIT"))
CvUNIQUE_on(PL_compcv);
{ $$ = start_subparse(TRUE, 0); }
;
-subname : WORD { char *name = SvPV(((SVOP*)$1)->op_sv, PL_na);
+subname : WORD { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
|| strEQ(name, "INIT"))
CvUNIQUE_on(PL_compcv);
/* Check the eval first */
if (SvTRUE(ERRSV))
{
- printf ("Uh oh - %s\n", SvPV(ERRSV, PL_na)) ;
+ STRLEN n_a;
+ printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ;
POPs ;
}
else
if (SvTRUE(ERRSV))
{
- printf ("Uh oh - %s\n", SvPV(ERRSV, PL_na)) ;
+ STRLEN n_a;
+ printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ;
POPs ;
}
main (int argc, char **argv, char **env)
{
+ STRLEN n_a;
char *embedding[] = { "", "-e", "0" };
my_perl = perl_alloc();
/** Treat $a as a string **/
perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE);
- printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), PL_na));
+ printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), n_a));
perl_destruct(my_perl);
perl_free(my_perl);
from I<perl_eval_pv()> instead. Example:
...
+ STRLEN n_a;
SV *val = perl_eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE);
- printf("%s\n", SvPV(val,PL_na));
+ printf("%s\n", SvPV(val,n_a));
...
This way, we avoid namespace pollution by not creating global
{
dSP;
SV* retval;
+ STRLEN n_a;
PUSHMARK(SP);
perl_eval_sv(sv, G_SCALAR);
PUTBACK;
if (croak_on_error && SvTRUE(ERRSV))
- croak(SvPVx(ERRSV, PL_na));
+ croak(SvPVx(ERRSV, n_a));
return retval;
}
I32 match(SV *string, char *pattern)
{
SV *command = NEWSV(1099, 0), *retval;
+ STRLEN n_a;
sv_setpvf(command, "my $string = '%s'; $string =~ %s",
- SvPV(string,PL_na), pattern);
+ SvPV(string,n_a), pattern);
retval = my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
I32 substitute(SV **string, char *pattern)
{
SV *command = NEWSV(1099, 0), *retval;
+ STRLEN n_a;
sv_setpvf(command, "$string = '%s'; ($string =~ %s)",
- SvPV(*string,PL_na), pattern);
+ SvPV(*string,n_a), pattern);
retval = my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
{
SV *command = NEWSV(1099, 0);
I32 num_matches;
+ STRLEN n_a;
sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)",
- SvPV(string,PL_na), pattern);
+ SvPV(string,n_a), pattern);
my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
AV *match_list;
I32 num_matches, i;
SV *text = NEWSV(1099,0);
+ STRLEN n_a;
perl_construct(my_perl);
perl_parse(my_perl, NULL, 3, embedding, NULL);
printf("matches: m/(wi..)/g found %d matches...\n", num_matches);
for (i = 0; i < num_matches; i++)
- printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),PL_na));
+ printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),n_a));
printf("\n");
/** Remove all vowels from text **/
if (num_matches) {
printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
num_matches);
- printf("Now text is: %s\n\n", SvPV(text,PL_na));
+ printf("Now text is: %s\n\n", SvPV(text,n_a));
}
/** Attempt a substitution **/
char *args[] = { "", DO_CLEAN, NULL };
char filename [1024];
int exitstatus = 0;
+ STRLEN n_a;
if((perl = perl_alloc()) == NULL) {
fprintf(stderr, "no memory!");
/* check $@ */
if(SvTRUE(ERRSV))
- fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,PL_na));
+ fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,n_a));
}
}
In the C<SvPV> macro, the length of the string returned is placed into the
variable C<len> (this is a macro, so you do I<not> use C<&len>). If you do not
-care what the length of the data is, use the global variable C<PL_na>. Remember,
+care what the length of the data is, use the global variable C<PL_na>, though
+this is rather less efficient than using a local variable. Remember,
however, that Perl allows arbitrary strings of data that may both contain
NULs and might not be terminated by a NUL.
variable which corresponds to Perl's $DB::sub variable. See C<PL_DBsingle>.
The sub name can be found by
- SvPV( GvSV( PL_DBsub ), PL_na )
+ SvPV( GvSV( PL_DBsub ), len )
=item PL_DBtrace
necessary dereferencing of possibly C<SV*> keys. The length of
the string is placed in C<len> (this is a macro, so do I<not> use
C<&len>). If you do not care about what the length of the key is,
-you may use the global variable C<PL_na>. Remember though, that hash
+you may use the global variable C<PL_na>, though this is rather less
+efficient than using a local variable. Remember though, that hash
keys in perl are free to contain embedded nulls, so using C<strlen()>
or similar is not a good way to find the length of hash keys.
This is very similar to the C<SvPV()> macro described elsewhere in
=item PL_na
-A variable which may be used with C<SvPV> to tell Perl to calculate the
-string length.
+A convenience variable which is typically used with C<SvPV> when one doesn't
+care about the length of the string. It is usually more efficient to
+declare a local variable and use that instead.
=item New
=item SvPV
Returns a pointer to the string in the SV, or a stringified form of the SV
-if the SV does not contain a string. If C<len> is C<PL_na> then Perl will
-handle the length on its own. Handles 'get' magic.
+if the SV does not contain a string. Handles 'get' magic.
char* SvPV (SV* sv, int len )
time_t timep = NO_INIT
PREINIT:
char *host = "localhost";
+ STRLEN n_a;
CODE:
if( items > 1 )
- host = (char *)SvPV(ST(1), PL_na);
+ host = (char *)SvPV(ST(1), n_a);
RETVAL = rpcb_gettime( host, &timep );
OUTPUT:
timep
PROTOTYPE: $;$
PREINIT:
char *host = "localhost";
+ STRLEN n_a;
CODE:
if( items > 1 )
- host = (char *)SvPV(ST(1), PL_na);
+ host = (char *)SvPV(ST(1), n_a);
RETVAL = rpcb_gettime( host, &timep );
OUTPUT:
timep
else {
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
+ STRLEN n_a;
if (SvGMAGICAL(sv)) {
mg_get(sv);
warner(WARN_UNINITIALIZED, PL_warn_uninit);
RETSETUNDEF;
}
- sym = SvPV(sv, PL_na);
+ sym = SvPV(sv, n_a);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(PL_no_symref, sym, "a symbol");
sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
else {
GV *gv = (GV*)sv;
char *sym;
+ STRLEN n_a;
if (SvTYPE(gv) != SVt_PVGV) {
if (SvGMAGICAL(sv)) {
warner(WARN_UNINITIALIZED, PL_warn_uninit);
RETSETUNDEF;
}
- sym = SvPV(sv, PL_na);
+ sym = SvPV(sv, n_a);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(PL_no_symref, sym, "a SCALAR");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
SV *tmpRef;
char *elem;
djSP;
-
+ STRLEN n_a;
+
sv = POPs;
- elem = SvPV(sv, PL_na);
+ elem = SvPV(sv, n_a);
gv = (GV*)POPs;
tmpRef = Nullsv;
sv = Nullsv;
djSP; dTARGET;
char *tmps;
I32 argtype;
+ STRLEN n_a;
- tmps = POPp;
+ tmps = POPpx;
XPUSHu(scan_hex(tmps, 99, &argtype));
RETURN;
}
UV value;
I32 argtype;
char *tmps;
+ STRLEN n_a;
- tmps = POPp;
+ tmps = POPpx;
while (*tmps && isSPACE(*tmps))
tmps++;
if (*tmps == '0')
if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
- SvPV_force(sv,PL_na);
+ STRLEN n_a;
+ SvPV_force(sv,n_a);
if (ckWARN(WARN_SUBSTR))
warner(WARN_SUBSTR,
"Attempt to use reference as lvalue in substr");
{
djSP; dTARGET;
UV value;
- U8 *tmps = (U8*)POPp;
+ STRLEN n_a;
+ U8 *tmps = (U8*)POPpx;
I32 retlen;
if (IN_UTF8 && (*tmps & 0x80))
PP(pp_crypt)
{
djSP; dTARGET; dPOPTOPssrl;
+ STRLEN n_a;
#ifdef HAS_CRYPT
- char *tmps = SvPV(left, PL_na);
+ char *tmps = SvPV(left, n_a);
#ifdef FCRYPT
- sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na)));
+ sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
#else
- sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, PL_na)));
+ sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
#endif
#else
DIE(
sv = TARG;
SETs(sv);
}
- s = (U8*)SvPV_force(sv, PL_na);
+ s = (U8*)SvPV_force(sv, slen);
if (*s) {
if (PL_op->op_private & OPpLOCALE) {
TAINT;
sv = TARG;
SETs(sv);
}
- s = (U8*)SvPV_force(sv, PL_na);
+ s = (U8*)SvPV_force(sv, slen);
if (*s) {
if (PL_op->op_private & OPpLOCALE) {
TAINT;
svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
}
if (lval) {
- if (!svp || *svp == &PL_sv_undef)
- DIE(PL_no_helem, SvPV(keysv, PL_na));
+ if (!svp || *svp == &PL_sv_undef) {
+ STRLEN n_a;
+ DIE(PL_no_helem, SvPV(keysv, n_a));
+ }
if (PL_op->op_private & OPpLVAL_INTRO)
save_helem(hv, keysv, svp);
}
}
else if (++bytes >= sizeof(UV)) { /* promote to string */
char *t;
+ STRLEN n_a;
sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
while (s < strend) {
break;
}
}
- t = SvPV(sv, PL_na);
+ t = SvPV(sv, n_a);
while (*t == '0')
t++;
sv_chop(sv, t);
STATIC SV *
is_an_int(char *s, STRLEN l)
{
+ STRLEN n_a;
SV *result = newSVpv("", l);
- char *result_c = SvPV(result, PL_na); /* convenience */
+ char *result_c = SvPV(result, n_a); /* convenience */
char *out = result_c;
bool skip = 1;
bool ignore = 0;
if (fromstr == &PL_sv_undef)
aptr = NULL;
else {
+ STRLEN n_a;
/* XXX better yet, could spirit away the string to
* a safe spot and hang on to it until the result
* of pack() (and all copies of the result) are
warner(WARN_UNSAFE,
"Attempt to pack pointer to temporary value");
if (SvPOK(fromstr) || SvNIOK(fromstr))
- aptr = SvPV(fromstr,PL_na);
+ aptr = SvPV(fromstr,n_a);
else
- aptr = SvPV_force(fromstr,PL_na);
+ aptr = SvPV_force(fromstr,n_a);
}
sv_catpvn(cat, (char*)&aptr, sizeof(char*));
}
#define RETURNX(x) return x, PUTBACK, NORMAL
#define POPs (*sp--)
-#define POPp (SvPVx(POPs, PL_na))
+#define POPp (SvPVx(POPs, PL_na)) /* deprecated */
+#define POPpx (SvPVx(POPs, n_a))
#define POPn (SvNVx(POPs))
#define POPi ((IV)SvIVx(POPs))
#define POPu ((UV)SvUVx(POPs))
#define POPl ((long)SvIVx(POPs))
#define TOPs (*sp)
-#define TOPp (SvPV(TOPs, PL_na))
+#define TOPp (SvPV(TOPs, PL_na)) /* deprecated */
+#define TOPpx (SvPV(TOPs, n_a))
#define TOPn (SvNV(TOPs))
#define TOPi ((IV)SvIV(TOPs))
#define TOPu ((UV)SvUV(TOPs))
if (*up = *++MARK) { /* Weed out nulls. */
SvTEMP_off(*up);
if (!PL_sortcop && !SvPOK(*up)) {
+ STRLEN n_a;
if (SvAMAGIC(*up))
overloading = 1;
else
- (void)sv_2pv(*up, &PL_na);
+ (void)sv_2pv(*up, &n_a);
}
up++;
}
}
else {
SV *final = sv_mortalcopy(right);
- STRLEN len;
+ STRLEN len, n_a;
char *tmps = SvPV(final, len);
sv = sv_mortalcopy(left);
- SvPV_force(sv,PL_na);
+ SvPV_force(sv,n_a);
while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
XPUSHs(sv);
if (strEQ(SvPVX(sv),tmps))
die_where(char *message)
{
dSP;
+ STRLEN n_a;
if (PL_in_eval) {
I32 cxix;
register PERL_CONTEXT *cx;
sv_setpv(ERRSV, message);
}
else
- message = SvPVx(ERRSV, PL_na);
+ message = SvPVx(ERRSV, n_a);
while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
dounwind(-1);
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPVx(ERRSV, PL_na);
+ char* msg = SvPVx(ERRSV, n_a);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
return pop_return();
}
}
if (!message)
- message = SvPVx(ERRSV, PL_na);
+ message = SvPVx(ERRSV, n_a);
PerlIO_printf(PerlIO_stderr(), "%s",message);
PerlIO_flush(PerlIO_stderr());
my_failure_exit();
{
djSP;
char *tmps;
+ STRLEN n_a;
if (MAXARG < 1)
tmps = "";
else
- tmps = POPp;
+ tmps = POPpx;
sv_reset(tmps, PL_curcop->cop_stash);
PUSHs(&PL_sv_yes);
RETURN;
label = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV *sv = POPs;
+ STRLEN n_a;
/* This egregious kludge implements goto &subroutine */
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
}
}
else
- label = SvPV(sv,PL_na);
+ label = SvPV(sv,n_a);
}
else if (PL_op->op_flags & OPf_SPECIAL) {
if (! do_dump)
if (PL_multiline)
PL_op = PL_op->op_next; /* can't assume anything */
else {
- match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255;
+ STRLEN n_a;
+ match = *(SvPVx(GvSV(cCOP->cop_gv), n_a)) & 255;
match -= cCOP->uop.scop.scop_offset;
if (match < 0)
match = 0;
I32 gimme;
PERL_CONTEXT *cx;
I32 optype = 0; /* Might be reset by POPEVAL. */
+ STRLEN n_a;
PL_op = saveop;
if (PL_eval_root) {
lex_end();
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPVx(ERRSV, PL_na);
+ char* msg = SvPVx(ERRSV, n_a);
DIE("%s", *msg ? msg : "Compilation failed in require");
} else if (startop) {
- char* msg = SvPVx(ERRSV, PL_na);
+ char* msg = SvPVx(ERRSV, n_a);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
SV** svp;
I32 gimme = G_SCALAR;
PerlIO *tryrsfp = 0;
+ STRLEN n_a;
sv = POPs;
if (SvNIOKp(sv) && !SvPOKp(sv)) {
SET_NUMERIC_STANDARD();
if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
DIE("Perl %s required--this is only version %s, stopped",
- SvPV(sv,PL_na),PL_patchlevel);
+ SvPV(sv,n_a),PL_patchlevel);
RETPUSHYES;
}
name = SvPV(sv, len);
{
namesv = NEWSV(806, 0);
for (i = 0; i <= AvFILL(ar); i++) {
- char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na);
+ char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
#ifdef VMS
char *unixdir;
if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
sv_catpv(msg, " (did you run h2ph?)");
sv_catpv(msg, " (@INC contains:");
for (i = 0; i <= AvFILL(ar); i++) {
- char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na);
+ char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
sv_setpvf(dirmsgsv, " %s", dir);
sv_catsv(msg, dirmsgsv);
}
IO *io;
register PerlIO *fp;
MAGIC *mg;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
if (ckWARN(WARN_UNOPENED)) {
SV* sv = sv_newmortal();
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);
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, "print on closed filehandle %s",
- SvPV(sv,PL_na));
+ SvPV(sv,n_a));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
+ STRLEN n_a;
if (SvGMAGICAL(sv)) {
mg_get(sv);
}
RETSETUNDEF;
}
- sym = SvPV(sv,PL_na);
+ sym = SvPV(sv,n_a);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(PL_no_symref, sym, "an ARRAY");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
+ STRLEN n_a;
if (SvGMAGICAL(sv)) {
mg_get(sv);
}
RETSETUNDEF;
}
- sym = SvPV(sv,PL_na);
+ sym = SvPV(sv,n_a);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(PL_no_symref, sym, "a HASH");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
if (!svp || *svp == &PL_sv_undef) {
SV* lv;
SV* key2;
- if (!defer)
- DIE(PL_no_helem, SvPV(keysv, PL_na));
+ if (!defer) {
+ STRLEN n_a;
+ DIE(PL_no_helem, SvPV(keysv, n_a));
+ }
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
default:
if (!SvROK(sv)) {
char *sym;
+ STRLEN n_a;
if (sv == &PL_sv_yes) { /* unfound import, ignore */
if (hasargs)
sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
}
else
- sym = SvPV(sv, PL_na);
+ sym = SvPV(sv, n_a);
if (!sym)
DIE(PL_no_usym, "a subroutine");
if (PL_op->op_private & HINT_STRICT_REFS)
}
}
- name = SvPV(TOPs, PL_na);
+ name = SvPV(TOPs, packlen);
sv = *(PL_stack_base + TOPMARK + 1);
if (SvGMAGICAL(sv))
{
djSP; dTARGET;
PerlIO *fp;
- char *tmps = POPp;
+ STRLEN n_a;
+ char *tmps = POPpx;
I32 gimme = GIMME_V;
TAINT_PROPER("``");
#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)
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);
struct timeval *tbuf = &timebuf;
I32 growsize;
char *fd_sets[4];
+ STRLEN n_a;
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
I32 masksize;
I32 offset;
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);
PerlIO *fp;
SV *sv;
MAGIC *mg;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
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;
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)
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);
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'))
+ if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
warner(WARN_NEWLINE, PL_warn_nl, "stat");
max = 0;
}
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)
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)
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)
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)
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)
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)
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'))
+ if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
warner(WARN_NEWLINE, PL_warn_nl, "open");
RETPUSHUNDEF;
}
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");
djSP; dTARGET;
char *tmps;
#ifdef HAS_CHROOT
- tmps = POPp;
+ STRLEN n_a;
+ tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
RETURN;
{
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
{
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;
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);
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;
#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
}
#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
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
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
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;
}
else if (which == OP_GSBYPORT) {
#ifdef HAS_GETSERVBYPORT
- char *proto = POPp;
+ char *proto = POPpx;
unsigned short port = POPu;
#ifdef HAS_HTONS
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
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
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;
}
{
#ifdef DEBUGGING
SV *sv;
+ STRLEN n_a;
deb("%s", PL_op_name[o->op_type]);
switch (o->op_type) {
case OP_CONST:
if (cGVOPo->op_gv) {
sv = NEWSV(0,0);
gv_fullname3(sv, cGVOPo->op_gv, Nullch);
- PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, PL_na));
+ PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
SvREFCNT_dec(sv);
}
else
{
IO* io;
GV* gv;
+ STRLEN n_a;
switch (SvTYPE(sv)) {
case SVt_PVIO:
croak(PL_no_usym, "filehandle");
if (SvROK(sv))
return sv_2io(SvRV(sv));
- gv = gv_fetchpv(SvPV(sv,PL_na), FALSE, SVt_PVIO);
+ gv = gv_fetchpv(SvPV(sv,n_a), FALSE, SVt_PVIO);
if (gv)
io = GvIO(gv);
else
io = 0;
if (!io)
- croak("Bad filehandle: %s", SvPV(sv,PL_na));
+ croak("Bad filehandle: %s", SvPV(sv,n_a));
break;
}
return io;
{
GV *gv;
CV *cv;
+ STRLEN n_a;
if (!sv)
return *gvp = Nullgv, Nullcv;
else if (isGV(sv))
gv = (GV*)sv;
else
- gv = gv_fetchpv(SvPV(sv, PL_na), lref, SVt_PVCV);
+ gv = gv_fetchpv(SvPV(sv, n_a), lref, SVt_PVCV);
*gvp = gv;
if (!gv)
return Nullcv;
Nullop);
LEAVE;
if (!GvCVu(gv))
- croak("Unable to create sub named \"%s\"", SvPV(sv,PL_na));
+ croak("Unable to create sub named \"%s\"", SvPV(sv,n_a));
}
return GvCVu(gv);
}
if ($times > 1) {
# Multiply defined users are rarely intentional.
local $" = ", ";
- warn "# User '$_' defined multiple times in $where, lines: @{$seen{$_}}.\n";
+ print "# User '$_' defined multiple times in $where, lines: @{$seen{$_}}.\n";
delete $suspect{$_};
}
}
svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
if (svp && *svp && SvTAINTED(*svp)) {
dTHR; /* just for taint */
+ STRLEN n_a;
bool was_tainted = PL_tainted;
- char *t = SvPV(*svp, PL_na);
- char *e = t + PL_na;
+ char *t = SvPV(*svp, n_a);
+ char *e = t + n_a;
PL_tainted = was_tainted;
if (t < e && isALNUM(*t))
t++;
if (!SvUPGRADE(datasv, SVt_PVIO))
die("Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
- if (filter_debug)
- warn("filter_add func %p (%s)", funcp, SvPV(datasv,PL_na));
+ if (filter_debug) {
+ STRLEN n_a;
+ warn("filter_add func %p (%s)", funcp, SvPV(datasv, n_a));
+ }
av_unshift(PL_rsfp_filters, 1);
av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
}
/* Get function pointer hidden within datasv */
funcp = (filter_t)IoDIRP(datasv);
- if (filter_debug)
+ if (filter_debug) {
+ STRLEN n_a;
warn("filter_read %d: via function %p (%s)\n",
- idx, funcp, SvPV(datasv,PL_na));
+ idx, funcp, SvPV(datasv,n_a));
+ }
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
case 'z': case 'Z':
keylookup: {
+ STRLEN n_a;
gv = Nullgv;
gvp = 0;
if (gv && GvCVu(gv)) {
CV *cv;
if ((cv = GvCV(gv)) && SvPOK(cv))
- PL_last_proto = SvPV((SV*)cv, PL_na);
+ PL_last_proto = SvPV((SV*)cv, n_a);
for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
if (*d == ')' && (sv = cv_const_sv(cv))) {
s = d + 1;
PL_lex_stuff = Nullsv;
}
- if (*SvPV(PL_subname,PL_na) == '?') {
+ if (*SvPV(PL_subname,n_a) == '?') {
sv_setpv(PL_subname,"__ANON__");
TOKEN(ANONSUB);
}
dXSARGS;
SV *sv;
char *name;
+ STRLEN n_a;
if (items != 2)
croak("Usage: UNIVERSAL::isa(reference, kind)");
sv = ST(0);
- name = (char *)SvPV(ST(1),PL_na);
+ name = (char *)SvPV(ST(1),n_a);
ST(0) = boolSV(sv_derived_from(sv, name));
XSRETURN(1);
char *name;
SV *rv;
HV *pkg = NULL;
+ STRLEN n_a;
if (items != 2)
croak("Usage: UNIVERSAL::can(object-ref, method)");
sv = ST(0);
- name = (char *)SvPV(ST(1),PL_na);
+ name = (char *)SvPV(ST(1),n_a);
rv = &PL_sv_undef;
if(SvROK(sv)) {
undef = "(undef)";
}
- if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv))))
+ if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv)))) {
+ STRLEN n_a;
croak("%s version %s required--this is only version %s",
- HvNAME(pkg), SvPV(ST(1),PL_na), undef ? undef : SvPV(sv,PL_na));
+ HvNAME(pkg), SvPV(ST(1),n_a), undef ? undef : SvPV(sv,n_a));
+ }
ST(0) = sv;
fdMap[3];
SV *sv,
**p_sv;
+ STRLEN n_a;
status = FAIL;
if (sp > mark)
while (++mark <= sp)
{
if (*mark)
- *a++ = SvPVx(*mark, PL_na);
+ *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
}
/*-----------------------------------------------------*/
if (*PL_Argv[0] != '/')
TAINT_ENV();
- if (really && *(tmps = SvPV(really, PL_na)))
+ if (really && *(tmps = SvPV(really, n_a)))
pid = spawnp(tmps, nFd, fdMap, &inherit,
(const char **) PL_Argv,
(const char **) environ);
struct FAB deffab = cc$rms_fab;
struct NAM defnam = cc$rms_nam;
struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+ STRLEN n_a;
if (items) {
SV *defsv = ST(items-1); /* mimic chdir() */
ST(0) = &PL_sv_undef;
if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); }
- if (tovmsspec(SvPV(defsv,PL_na),vmsdef) == NULL) { XSRETURN(1); }
+ if (tovmsspec(SvPV(defsv,n_a),vmsdef) == NULL) { XSRETURN(1); }
deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef);
}
else {
char *args[8],mode[3] = {'r','\0','\0'}, type = '<';
register int i, myargc;
FILE *fp;
+ STRLEN n_a;
if (!spec || !*spec) {
SETERRNO(EINVAL,LIB$_INVARG);
}
else if (*spec == '<') spec++;
myargc = items - 1;
- for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),PL_na);
+ for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),n_a);
/* This hack brought to you by C's opaque arglist management */
switch (myargc) {
case 0:
int i, myargc, fd;
FILE *fp;
SV *fh;
+ STRLEN n_a;
if (!spec || !*spec) {
SETERRNO(EINVAL,LIB$_INVARG);
XSRETURN_UNDEF;
}
if (items > 11) croak("too many args");
myargc = items - 3;
- for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),PL_na);
+ for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),n_a);
/* More fun with C calls; can't combine with above because
args 2,3 of different types in fopen() and open() */
switch (myargc) {
break;
case 57:
#line 302 "perly.y"
-{ char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na);
+{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
|| strEQ(name, "INIT"))
CvUNIQUE_on(PL_compcv);
register size_t cmdlen = 0;
size_t rlen;
register SV **idx;
+ STRLEN n_a;
idx = mark;
if (really) {
while (++mark <= sp) {
if (*mark) {
strcat(PL_Cmd," ");
- strcat(PL_Cmd,SvPVx(*mark,PL_na));
+ strcat(PL_Cmd,SvPVx(*mark,n_a));
}
}
return PL_Cmd;
{
dXSARGS;
char *fspec, *defspec = NULL, *rslt;
+ STRLEN n_a;
if (!items || items > 2)
croak("Usage: VMS::Filespec::rmsexpand(spec[,defspec])");
- fspec = SvPV(ST(0),PL_na);
+ fspec = SvPV(ST(0),n_a);
if (!fspec || !*fspec) XSRETURN_UNDEF;
- if (items == 2) defspec = SvPV(ST(1),PL_na);
+ if (items == 2) defspec = SvPV(ST(1),n_a);
rslt = do_rmsexpand(fspec,NULL,1,defspec,0);
ST(0) = sv_newmortal();
{
dXSARGS;
char *vmsified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::vmsify(spec)");
- vmsified = do_tovmsspec(SvPV(ST(0),PL_na),NULL,1);
+ vmsified = do_tovmsspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (vmsified != NULL) sv_usepvn(ST(0),vmsified,strlen(vmsified));
XSRETURN(1);
{
dXSARGS;
char *unixified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::unixify(spec)");
- unixified = do_tounixspec(SvPV(ST(0),PL_na),NULL,1);
+ unixified = do_tounixspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (unixified != NULL) sv_usepvn(ST(0),unixified,strlen(unixified));
XSRETURN(1);
{
dXSARGS;
char *fileified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::fileify(spec)");
- fileified = do_fileify_dirspec(SvPV(ST(0),PL_na),NULL,1);
+ fileified = do_fileify_dirspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (fileified != NULL) sv_usepvn(ST(0),fileified,strlen(fileified));
XSRETURN(1);
{
dXSARGS;
char *pathified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::pathify(spec)");
- pathified = do_pathify_dirspec(SvPV(ST(0),PL_na),NULL,1);
+ pathified = do_pathify_dirspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (pathified != NULL) sv_usepvn(ST(0),pathified,strlen(pathified));
XSRETURN(1);
{
dXSARGS;
char *vmspath;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::vmspath(spec)");
- vmspath = do_tovmspath(SvPV(ST(0),PL_na),NULL,1);
+ vmspath = do_tovmspath(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (vmspath != NULL) sv_usepvn(ST(0),vmspath,strlen(vmspath));
XSRETURN(1);
{
dXSARGS;
char *unixpath;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::unixpath(spec)");
- unixpath = do_tounixpath(SvPV(ST(0),PL_na),NULL,1);
+ unixpath = do_tounixpath(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (unixpath != NULL) sv_usepvn(ST(0),unixpath,strlen(unixpath));
XSRETURN(1);
char fspec[NAM$C_MAXRSS+1], *fsp;
SV *mysv;
IO *io;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)");
fsp = fspec;
}
else {
- if (mysv != ST(0) || !(fsp = SvPV(mysv,PL_na)) || !*fsp) {
+ if (mysv != ST(0) || !(fsp = SvPV(mysv,n_a)) || !*fsp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
unsigned long int sts;
SV *mysv;
IO *io;
+ STRLEN n_a;
if (items < 2 || items > 3)
croak("Usage: File::Copy::rmscopy(from,to[,date_flag])");
inp = inspec;
}
else {
- if (mysv != ST(0) || !(inp = SvPV(mysv,PL_na)) || !*inp) {
+ if (mysv != ST(0) || !(inp = SvPV(mysv,n_a)) || !*inp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
outp = outspec;
}
else {
- if (mysv != ST(1) || !(outp = SvPV(mysv,PL_na)) || !*outp) {
+ if (mysv != ST(1) || !(outp = SvPV(mysv,n_a)) || !*outp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
int status;
int flag = P_WAIT;
int index = 0;
+ STRLEN n_a;
if (sp <= mark)
return -1;
}
while (++mark <= sp) {
- if (*mark && (str = SvPV(*mark, PL_na)))
+ if (*mark && (str = SvPV(*mark, n_a)))
argv[index++] = str;
else
argv[index++] = "";
argv[index++] = 0;
status = win32_spawnvp(flag,
- (const char*)(really ? SvPV(really,PL_na) : argv[0]),
+ (const char*)(really ? SvPV(really,n_a) : argv[0]),
(const char* const*)argv);
if (status < 0 && errno == ENOEXEC) {
argv[sh_items] = w32_perlshell_vec[sh_items];
status = win32_spawnvp(flag,
- (const char*)(really ? SvPV(really,PL_na) : argv[0]),
+ (const char*)(really ? SvPV(really,n_a) : argv[0]),
(const char* const*)argv);
}
XS(w32_SetCwd)
{
dXSARGS;
+ STRLEN n_a;
if (items != 1)
croak("usage: Win32::SetCurrentDirectory($cwd)");
- if (SetCurrentDirectory(SvPV(ST(0),PL_na)))
+ if (SetCurrentDirectory(SvPV(ST(0),n_a)))
XSRETURN_YES;
XSRETURN_NO;
PROCESS_INFORMATION stProcInfo;
STARTUPINFO stStartInfo;
BOOL bSuccess = FALSE;
+ STRLEN n_a;
if (items != 3)
croak("usage: Win32::Spawn($cmdName, $args, $PID)");
- cmd = SvPV(ST(0),PL_na);
- args = SvPV(ST(1), PL_na);
+ cmd = SvPV(ST(0), n_a);
+ args = SvPV(ST(1), n_a);
memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
projects / p5sagit/p5-mst-13.2.git / commitdiff