STATIC int
S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
{
- (void)path;
- (void)mode;
+ PERL_UNUSED_ARG(path);
+ PERL_UNUSED_ARG(mode);
Perl_croak(aTHX_ "switching effective uid is not implemented");
/*NOTREACHED*/
return -1;
SAVESPTR(PL_rs);
PL_rs = &PL_sv_undef;
sv_setpvn(TARG, "", 0); /* note that this preserves previous buffer */
- while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
+ while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
;
LEAVE;
XPUSHs(TARG);
}
else {
for (;;) {
- SV * const sv = NEWSV(56, 79);
- if (sv_gets(sv, fp, 0) == Nullch) {
+ SV * const sv = newSV(79);
+ if (sv_gets(sv, fp, 0) == NULL) {
SvREFCNT_dec(sv);
break;
}
}
else {
tmpsv = TOPs;
- tmps = SvROK(tmpsv) ? Nullch : SvPV_const(tmpsv, len);
+ tmps = SvROK(tmpsv) ? NULL : SvPV_const(tmpsv, len);
}
if (!tmps || !len) {
SV * const error = ERRSV;
sv_setsv(error,*PL_stack_sp--);
}
}
- DIE(aTHX_ Nullch);
+ DIE(aTHX_ NULL);
}
else {
if (SvPOK(error) && SvCUR(error))
if (SvOK(tmpsv))
tmps = SvPV_const(tmpsv, len);
else
- tmps = Nullch;
+ tmps = NULL;
}
}
if (!tmps || !len)
}
tmps = SvPV_const(sv, len);
- ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK));
+ ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, NULL, MARK+1, (SP-MARK));
SP = ORIGMARK;
if (ok)
PUSHi( (I32)PL_forkprocess );
IO *io;
PerlIO *fp;
MAGIC *mg;
- SV *discp = Nullsv;
+ SV *discp = NULL;
if (MAXARG < 1)
RETPUSHUNDEF;
PUTBACK;
if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
- (discp) ? SvPV_nolen_const(discp) : Nullch)) {
+ (discp) ? SvPV_nolen_const(discp) : NULL)) {
if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io),
mode_from_discipline(discp),
- (discp) ? SvPV_nolen_const(discp) : Nullch)) {
+ (discp) ? SvPV_nolen_const(discp) : NULL)) {
SPAGAIN;
RETPUSHUNDEF;
}
SvTYPE(varsv) == SVt_PVHV))
Perl_croak(aTHX_
"Self-ties of arrays and hashes are not supported");
- sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
+ sv_magic(varsv, (SvRV(sv) == varsv ? NULL : sv), how, NULL, 0);
}
LEAVE;
SP = PL_stack_base + markoff;
GV *gv;
HV * const hv = (HV*)POPs;
- SV * const sv = sv_mortalcopy(&PL_sv_no);
-
- sv_setpv(sv, "AnyDBM_File");
+ SV * const sv = sv_2mortal(newSVpvs("AnyDBM_File"));
stash = gv_stashsv(sv, FALSE);
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
PUTBACK;
if (sv_isobject(TOPs)) {
sv_unmagic((SV *) hv, PERL_MAGIC_tied);
- sv_magic((SV*)hv, TOPs, PERL_MAGIC_tied, Nullch, 0);
+ sv_magic((SV*)hv, TOPs, PERL_MAGIC_tied, NULL, 0);
}
LEAVE;
RETURN;
timebuf.tv_usec = (long)(value * 1000000.0);
}
else
- tbuf = Null(struct timeval*);
+ tbuf = NULL;
for (i = 1; i <= 3; i++) {
sv = SP[i];
if (GIMME == G_ARRAY && tbuf) {
value = (NV)(timebuf.tv_sec) +
(NV)(timebuf.tv_usec) / 1000000.0;
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setnv(sv, value);
+ PUSHs(sv_2mortal(newSVnv(value)));
}
RETURN;
#else
Perl_setdefout(pTHX_ GV *gv)
{
dVAR;
- if (gv)
- (void)SvREFCNT_inc(gv);
+ SvREFCNT_inc_simple_void(gv);
if (PL_defoutgv)
SvREFCNT_dec(PL_defoutgv);
PL_defoutgv = gv;
else {
GV * const * const gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
if (gvp && *gvp == egv) {
- gv_efullname4(TARG, PL_defoutgv, Nullch, TRUE);
+ gv_efullname4(TARG, PL_defoutgv, NULL, TRUE);
XPUSHTARG;
}
else {
else
fgv = gv;
+ if (!fgv) {
+ DIE(aTHX_ "Not a format reference");
+ }
cv = GvFORM(fgv);
if (!cv) {
- if (fgv) {
- SV * const tmpsv = sv_newmortal();
- const char *name;
- gv_efullname4(tmpsv, fgv, Nullch, FALSE);
- name = SvPV_nolen_const(tmpsv);
- if (name && *name)
- DIE(aTHX_ "Undefined format \"%s\" called", name);
- }
+ SV * const tmpsv = sv_newmortal();
+ const char *name;
+ gv_efullname4(tmpsv, fgv, NULL, FALSE);
+ name = SvPV_nolen_const(tmpsv);
+ if (name && *name)
+ DIE(aTHX_ "Undefined format \"%s\" called", name);
DIE(aTHX_ "Not a format reference");
}
if (CvCLONE(cv))
dVAR; dSP;
GV * const gv = cxstack[cxstack_ix].blk_sub.gv;
register IO * const io = GvIOp(gv);
- PerlIO * const ofp = IoOFP(io);
+ PerlIO *ofp;
PerlIO *fp;
SV **newsp;
I32 gimme;
register PERL_CONTEXT *cx;
+ if (!io || !(ofp = IoOFP(io)))
+ goto forget_top;
+
DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n",
(long)IoLINES_LEFT(io), (long)FmLINES(PL_formtarget)));
- if (!io || !ofp)
- goto forget_top;
+
if (IoLINES_LEFT(io) < FmLINES(PL_formtarget) &&
PL_formtarget != PL_toptarget)
{
topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
topgv = gv_fetchsv(topname, 0, SVt_PVFM);
if ((topgv && GvFORM(topgv)) ||
- !gv_fetchpv("top", 0, SVt_PVFM))
+ !gv_fetchpvs("top", GV_NOTQUAL, SVt_PVFM))
IoTOP_NAME(io) = savesvpv(topname);
else
IoTOP_NAME(io) = savepvs("top");
if (!cv) {
SV * const sv = sv_newmortal();
const char *name;
- gv_efullname4(sv, fgv, Nullch, FALSE);
+ gv_efullname4(sv, fgv, NULL, FALSE);
name = SvPV_nolen_const(sv);
if (name && *name)
- DIE(aTHX_ "Undefined top format \"%s\" called",name);
+ DIE(aTHX_ "Undefined top format \"%s\" called", name);
+ else
+ DIE(aTHX_ "Undefined top format called");
}
- /* why no:
- else
- DIE(aTHX_ "Undefined top format called");
- ?*/
- if (CvCLONE(cv))
+ if (cv && CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
- return doform(cv,gv,PL_op);
+ return doform(cv, gv, PL_op);
}
forget_top:
RETURN;
}
- sv = NEWSV(0,0);
+ sv = newSV(0);
if (!(io = GvIO(gv))) {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
/* Need TIEHANDLE method ? */
const char * const tmps = SvPV_const(sv, len);
/* FIXME? do_open should do const */
- if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
+ if (do_open(gv, tmps, len, TRUE, mode, perm, NULL)) {
IoLINES(GvIOp(gv)) = 0;
PUSHs(&PL_sv_yes);
}
if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
IoLINES(io) = 0;
IoFLAGS(io) &= ~IOf_START;
- do_open(gv, "-", 1, FALSE, O_RDONLY, 0, Nullfp);
+ do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
sv_setpvn(GvSV(gv), "-", 1);
SvSETMAGIC(GvSV(gv));
}
const unsigned int func = POPu;
const int optype = PL_op->op_type;
GV * const gv = (GV*)POPs;
- IO * const io = gv ? GvIOn(gv) : Null(IO*);
+ IO * const io = gv ? GvIOn(gv) : NULL;
char *s;
IV retval;
if (gv && (io = GvIO(gv)))
fp = IoIFP(io);
else {
- fp = Nullfp;
+ fp = NULL;
io = NULL;
}
/* XXX Looks to me like io is always NULL at this point */
if (!gv || !io) {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- if (IoIFP(io))
+ if (io && IoIFP(io))
do_close(gv, FALSE);
SETERRNO(EBADF,LIB_INVARG);
RETPUSHUNDEF;
if (!gv2 || !io2)
report_evil_fh(gv1, io2, PL_op->op_type);
}
- if (IoIFP(io1))
+ if (io1 && IoIFP(io1))
do_close(gv1, FALSE);
- if (IoIFP(io2))
+ if (io2 && IoIFP(io2))
do_close(gv2, FALSE);
RETPUSHUNDEF;
}
{
#ifdef HAS_SOCKET
dVAR; dSP;
-#ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */
- extern void GETPRIVMODE();
- extern void GETUSERMODE();
-#endif
SV * const addrsv = POPs;
/* OK, so on what platform does bind modify addr? */
const char *addr;
register IO * const io = GvIOn(gv);
STRLEN len;
int bind_ok = 0;
-#ifdef MPE
- int mpeprivmode = 0;
-#endif
if (!io || !IoIFP(io))
goto nuts;
addr = SvPV_const(addrsv, len);
TAINT_PROPER("bind");
-#ifdef MPE /* Deal with MPE bind() peculiarities */
- if (((struct sockaddr *)addr)->sa_family == AF_INET) {
- /* The address *MUST* stupidly be zero. */
- ((struct sockaddr_in *)addr)->sin_addr.s_addr = INADDR_ANY;
- /* PRIV mode is required to bind() to ports < 1024. */
- if (((struct sockaddr_in *)addr)->sin_port < 1024 &&
- ((struct sockaddr_in *)addr)->sin_port > 0) {
- GETPRIVMODE(); /* If this fails, we are aborted by MPE/iX. */
- mpeprivmode = 1;
- }
- }
-#endif /* MPE */
if (PerlSock_bind(PerlIO_fileno(IoIFP(io)),
(struct sockaddr *)addr, len) >= 0)
bind_ok = 1;
-#ifdef MPE /* Switch back to USER mode */
- if (mpeprivmode)
- GETUSERMODE();
-#endif /* MPE */
if (bind_ok)
RETPUSHYES;
#ifdef HAS_SOCKET
dVAR; dSP;
const int optype = PL_op->op_type;
- SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(NEWSV(22, 257)) : POPs;
+ SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(newSV(257)) : POPs;
const unsigned int optname = (unsigned int) POPi;
const unsigned int lvl = (unsigned int) POPi;
GV * const gv = (GV*)POPs;
if (!io || !IoIFP(io))
goto nuts;
- sv = sv_2mortal(NEWSV(22, 257));
+ sv = sv_2mortal(newSV(257));
(void)SvPOK_only(sv);
len = 256;
SvCUR_set(sv, len);
goto do_fstat;
}
sv_setpv(PL_statname, SvPV_nolen_const(sv));
- PL_statgv = Nullgv;
+ PL_statgv = NULL;
PL_laststype = PL_op->op_type;
if (PL_op->op_type == OP_LSTAT)
PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache);
dSP;
int fd;
GV *gv;
- SV *tmpsv = Nullsv;
+ SV *tmpsv = NULL;
STACKED_FTEST_CHECK;
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = (GV*)SvRV(POPs);
else
- gv = Nullgv;
+ gv = NULL;
if (gv) {
EXTEND(SP, 1);
else {
sv = POPs;
really_filename:
- PL_statgv = Nullgv;
+ PL_statgv = NULL;
PL_laststype = OP_STAT;
sv_setpv(PL_statname, SvPV_nolen_const(sv));
if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
(void)PerlIO_close(fp);
RETPUSHUNDEF;
}
- PerlIO_binmode(aTHX_ fp, '<', O_BINARY, Nullch);
+ PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
len = PerlIO_read(fp, tbuf, sizeof(tbuf));
(void)PerlIO_close(fp);
if (len <= 0) {
if( MAXARG == 1 ) {
SV * const sv = POPs;
- if (SvTYPE(sv) == SVt_PVGV) {
+ if (PL_op->op_flags & OPf_SPECIAL) {
+ gv = gv_fetchsv(sv, 0, SVt_PVIO);
+ }
+ else if (SvTYPE(sv) == SVt_PVGV) {
gv = (GV*)sv;
}
else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
#endif
}
else {
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
+ SETERRNO(EBADF, RMS_IFI);
PUSHi(0);
}
}
else {
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
+ SETERRNO(EBADF,RMS_IFI);
PUSHi(0);
}
#else
/* Need to save/restore 'PL_rs' ?? */
s = sv_gets(tmpsv, myfp, 0);
(void)PerlProc_pclose(myfp);
- if (s != Nullch) {
+ if (s != NULL) {
int e;
for (e = 1;
#ifdef HAS_SYS_ERRLIST
if (childpid < 0)
RETSETUNDEF;
if (!childpid) {
- GV * const tmpgv = gv_fetchpv("$", GV_ADD, SVt_PV);
+ GV * const tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV);
if (tmpgv) {
SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
}
else if (SP - MARK != 1)
- value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
+ value = (I32)do_aexec5(NULL, MARK, SP, pp[1], did_pipes);
else {
value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes);
}
}
else if (SP - MARK != 1) {
# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
- value = (I32)do_aspawn(Nullsv, MARK, SP);
+ value = (I32)do_aspawn(NULL, MARK, SP);
# else
- value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
+ value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP);
# endif
}
else {
}
else if (SP - MARK != 1)
#ifdef VMS
- value = (I32)vms_do_aexec(Nullsv, MARK, SP);
+ value = (I32)vms_do_aexec(NULL, MARK, SP);
#else
# ifdef __OPEN_VM
{
- (void ) do_aspawn(Nullsv, MARK, SP);
+ (void ) do_aspawn(NULL, MARK, SP);
value = 0;
}
# else
- value = (I32)do_aexec(Nullsv, MARK, SP);
+ value = (I32)do_aexec(NULL, MARK, SP);
# endif
#endif
else {
{
dVAR; dSP; dTARGET;
#ifdef BIG_TIME
- XPUSHn( time(Null(Time_t*)) );
+ XPUSHn( time(NULL) );
#else
- XPUSHi( time(Null(Time_t*)) );
+ XPUSHi( time(NULL) );
#endif
RETURN;
}
#endif
}
+/* I can't const this further without getting warnings about the types of
+ various arrays passed in from structures. */
+static SV *
+S_space_join_names_mortal(pTHX_ char *const *array)
+{
+ SV *target;
+
+ if (array && *array) {
+ target = sv_2mortal(newSVpvs(""));
+ while (1) {
+ sv_catpv(target, *array);
+ if (!*++array)
+ break;
+ sv_catpvs(target, " ");
+ }
+ } else {
+ target = sv_mortalcopy(&PL_sv_no);
+ }
+ return target;
+}
+
/* Get system info. */
PP(pp_ghostent)
}
if (hent) {
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setpv(sv, (char*)hent->h_name);
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- for (elem = hent->h_aliases; elem && *elem; elem++) {
- sv_catpv(sv, *elem);
- if (elem[1])
- sv_catpvs(sv, " ");
- }
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setiv(sv, (IV)hent->h_addrtype);
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+ PUSHs(sv_2mortal(newSVpv((char*)hent->h_name, 0)));
+ PUSHs(S_space_join_names_mortal(aTHX_ hent->h_aliases));
+ PUSHs(sv_2mortal(newSViv((IV)hent->h_addrtype)));
len = hent->h_length;
- sv_setiv(sv, (IV)len);
+ PUSHs(sv_2mortal(newSViv((IV)len)));
#ifdef h_addr
for (elem = hent->h_addr_list; elem && *elem; elem++) {
- XPUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setpvn(sv, *elem, len);
+ XPUSHs(sv_2mortal(newSVpvn(*elem, len)));
}
#else
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
if (hent->h_addr)
- sv_setpvn(sv, hent->h_addr, len);
+ PUSHs(newSVpvn(hent->h_addr, len));
+ else
+ PUSHs(sv_mortalcopy(&PL_sv_no));
#endif /* h_addr */
}
RETURN;
#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
dVAR; dSP;
I32 which = PL_op->op_type;
- register char **elem;
register SV *sv;
#ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
struct netent *getnetbyaddr(Netdb_net_t, int);
}
if (nent) {
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setpv(sv, nent->n_name);
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- for (elem = nent->n_aliases; elem && *elem; elem++) {
- sv_catpv(sv, *elem);
- if (elem[1])
- sv_catpvs(sv, " ");
- }
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setiv(sv, (IV)nent->n_addrtype);
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setiv(sv, (IV)nent->n_net);
+ PUSHs(sv_2mortal(newSVpv(nent->n_name, 0)));
+ PUSHs(S_space_join_names_mortal(aTHX_ nent->n_aliases));
+ PUSHs(sv_2mortal(newSViv((IV)nent->n_addrtype)));
+ PUSHs(sv_2mortal(newSViv((IV)nent->n_net)));
}
RETURN;
#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
dVAR; dSP;
I32 which = PL_op->op_type;
- register char **elem;
register SV *sv;
#ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
struct protoent *getprotobyname(Netdb_name_t);
}
if (pent) {
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setpv(sv, pent->p_name);
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- for (elem = pent->p_aliases; elem && *elem; elem++) {
- sv_catpv(sv, *elem);
- if (elem[1])
- sv_catpvs(sv, " ");
- }
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setiv(sv, (IV)pent->p_proto);
+ PUSHs(sv_2mortal(newSVpv(pent->p_name, 0)));
+ PUSHs(S_space_join_names_mortal(aTHX_ pent->p_aliases));
+ PUSHs(sv_2mortal(newSViv((IV)pent->p_proto)));
}
RETURN;
#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
dVAR; dSP;
I32 which = PL_op->op_type;
- register char **elem;
register SV *sv;
#ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
struct servent *getservbyname(Netdb_name_t, Netdb_name_t);
#ifdef HAS_GETSERVBYNAME
const char * const proto = POPpbytex;
const char * const name = POPpbytex;
- sent = PerlSock_getservbyname(name, (proto && !*proto) ? Nullch : proto);
+ sent = PerlSock_getservbyname(name, (proto && !*proto) ? NULL : proto);
#else
DIE(aTHX_ PL_no_sock_func, "getservbyname");
#endif
#ifdef HAS_HTONS
port = PerlSock_htons(port);
#endif
- sent = PerlSock_getservbyport(port, (proto && !*proto) ? Nullch : proto);
+ sent = PerlSock_getservbyport(port, (proto && !*proto) ? NULL : proto);
#else
DIE(aTHX_ PL_no_sock_func, "getservbyport");
#endif
}
if (sent) {
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setpv(sv, sent->s_name);
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- for (elem = sent->s_aliases; elem && *elem; elem++) {
- sv_catpv(sv, *elem);
- if (elem[1])
- sv_catpvs(sv, " ");
- }
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+ PUSHs(sv_2mortal(newSVpv(sent->s_name, 0)));
+ PUSHs(S_space_join_names_mortal(aTHX_ sent->s_aliases));
#ifdef HAS_NTOHS
- sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));
+ PUSHs(sv_2mortal(newSViv((IV)PerlSock_ntohs(sent->s_port))));
#else
- sv_setiv(sv, (IV)(sent->s_port));
+ PUSHs(sv_2mortal(newSViv((IV)(sent->s_port))));
#endif
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setpv(sv, sent->s_proto);
+ PUSHs(sv_2mortal(newSVpv(sent->s_proto, 0)));
}
RETURN;
}
if (pwent) {
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setpv(sv, pwent->pw_name);
+ PUSHs(sv_2mortal(newSVpv(pwent->pw_name, 0)));
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- SvPOK_off(sv);
+ PUSHs(sv = sv_2mortal(newSViv(0)));
/* If we have getspnam(), we try to dig up the shadow
* password. If we are underprivileged, the shadow
* interface will set the errno to EACCES or similar,
SvTAINTED_on(sv);
# endif
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
# if Uid_t_sign <= 0
- sv_setiv(sv, (IV)pwent->pw_uid);
+ PUSHs(sv_2mortal(newSViv((IV)pwent->pw_uid)));
# else
- sv_setuv(sv, (UV)pwent->pw_uid);
+ PUSHs(sv_2mortal(newSVuv((UV)pwent->pw_uid)));
# endif
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
# if Uid_t_sign <= 0
- sv_setiv(sv, (IV)pwent->pw_gid);
+ PUSHs(sv_2mortal(newSViv((IV)pwent->pw_gid)));
# else
- sv_setuv(sv, (UV)pwent->pw_gid);
+ PUSHs(sv_2mortal(newSVuv((UV)pwent->pw_gid)));
# endif
/* pw_change, pw_quota, and pw_age are mutually exclusive--
* because of the poor interface of the Perl getpw*(),
* not because there's some standard/convention saying so.
* A better interface would have been to return a hash,
* but we are accursed by our history, alas. --jhi. */
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
# ifdef PWCHANGE
- sv_setiv(sv, (IV)pwent->pw_change);
+ PUSHs(sv_2mortal(newSViv((IV)pwent->pw_change)));
# else
# ifdef PWQUOTA
- sv_setiv(sv, (IV)pwent->pw_quota);
+ PUSHs(sv_2mortal(newSViv((IV)pwent->pw_quota)));
# else
# ifdef PWAGE
- sv_setpv(sv, pwent->pw_age);
+ PUSHs(sv_2mortal(newSVpv(pwent->pw_age, 0)));
+# else
+ /* I think that you can never get this compiled, but just in case. */
+ PUSHs(sv_mortalcopy(&PL_sv_no));
# endif
# endif
# endif
/* pw_class and pw_comment are mutually exclusive--.
* see the above note for pw_change, pw_quota, and pw_age. */
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
# ifdef PWCLASS
- sv_setpv(sv, pwent->pw_class);
+ PUSHs(sv_2mortal(newSVpv(pwent->pw_class, 0)));
# else
# ifdef PWCOMMENT
- sv_setpv(sv, pwent->pw_comment);
+ PUSHs(sv_2mortal(newSVpv(pwent->pw_comment, 0)));
+# else
+ /* I think that you can never get this compiled, but just in case. */
+ PUSHs(sv_mortalcopy(&PL_sv_no));
# endif
# endif
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
# ifdef PWGECOS
- sv_setpv(sv, pwent->pw_gecos);
+ PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_gecos, 0)));
+# else
+ PUSHs(sv_mortalcopy(&PL_sv_no));
# endif
# ifndef INCOMPLETE_TAINTS
/* pw_gecos is tainted because user himself can diddle with it. */
SvTAINTED_on(sv);
# endif
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setpv(sv, pwent->pw_dir);
+ PUSHs(sv_2mortal(newSVpv(pwent->pw_dir, 0)));
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setpv(sv, pwent->pw_shell);
+ PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_shell, 0)));
# ifndef INCOMPLETE_TAINTS
/* pw_shell is tainted because user himself can diddle with it. */
SvTAINTED_on(sv);
# endif
# ifdef PWEXPIRE
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setiv(sv, (IV)pwent->pw_expire);
+ PUSHs(sv_2mortal(newSViv((IV)pwent->pw_expire)));
# endif
}
RETURN;
}
if (grent) {
- SV *sv;
- char **elem;
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setpv(sv, grent->gr_name);
+ PUSHs(sv_2mortal(newSVpv(grent->gr_name, 0)));
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
#ifdef GRPASSWD
- sv_setpv(sv, grent->gr_passwd);
+ PUSHs(sv_2mortal(newSVpv(grent->gr_passwd, 0)));
+#else
+ PUSHs(sv_mortalcopy(&PL_sv_no));
#endif
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
- sv_setiv(sv, (IV)grent->gr_gid);
+ PUSHs(sv_2mortal(newSViv((IV)grent->gr_gid)));
#if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API))
- PUSHs(sv = sv_mortalcopy(&PL_sv_no));
/* In UNICOS/mk (_CRAYMPP) the multithreading
* versions (getgrnam_r, getgrgid_r)
* seem to return an illegal pointer
* but the gr_mem is poisonous anyway.
* So yes, you cannot get the list of group
* members if building multithreaded in UNICOS/mk. */
- for (elem = grent->gr_mem; elem && *elem; elem++) {
- sv_catpv(sv, *elem);
- if (elem[1])
- sv_catpvs(sv, " ");
- }
+ PUSHs(S_space_join_names_mortal(aTHX_ grent->gr_mem));
#endif
}