mode = "rt";
fp = PerlProc_popen(tmps, mode);
if (fp) {
- const char * const type = PL_curcop->cop_io ? SvPV_nolen_const(PL_curcop->cop_io) : NULL;
+ const char * const type = Perl_PerlIO_context_layers(aTHX_ NULL);
if (type && *type)
PerlIO_apply_layers(aTHX_ fp,mode,type);
if (gimme == G_VOID) {
char tmpbuf[256];
while (PerlIO_read(fp, tmpbuf, sizeof tmpbuf) > 0)
- ;
+ NOOP;
}
else if (gimme == G_SCALAR) {
ENTER;
PL_rs = &PL_sv_undef;
sv_setpvn(TARG, "", 0); /* note that this preserves previous buffer */
while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
- ;
+ NOOP;
LEAVE;
XPUSHs(TARG);
SvTAINTED_on(TARG);
if (!isGV(gv))
DIE(aTHX_ PL_no_usym, "filehandle");
- if ((io = GvIOp(gv)))
+ if ((io = GvIOp(gv))) {
+ MAGIC *mg;
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
- if (io) {
- MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
if (mg) {
/* Method's args are same as ours ... */
/* ... except handle is replaced by the object */
PP(pp_close)
{
dVAR; dSP;
- IO *io;
- MAGIC *mg;
GV * const gv = (MAXARG == 0) ? PL_defoutgv : (GV*)POPs;
- if (gv && (io = GvIO(gv))
- && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
- {
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)io, mg));
- PUTBACK;
- ENTER;
- call_method("CLOSE", G_SCALAR);
- LEAVE;
- SPAGAIN;
- RETURN;
+ if (gv) {
+ IO * const io = GvIO(gv);
+ if (io) {
+ MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ if (mg) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)io, mg));
+ PUTBACK;
+ ENTER;
+ call_method("CLOSE", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ RETURN;
+ }
+ }
}
EXTEND(SP, 1);
PUSHs(boolSV(do_close(gv, TRUE)));
IoTYPE(wstio) = IoTYPE_WRONLY;
if (!IoIFP(rstio) || !IoOFP(wstio)) {
- if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
- else PerlLIO_close(fd[0]);
- if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
- else PerlLIO_close(fd[1]);
+ if (IoIFP(rstio))
+ PerlIO_close(IoIFP(rstio));
+ else
+ PerlLIO_close(fd[0]);
+ if (IoOFP(wstio))
+ PerlIO_close(IoOFP(wstio));
+ else
+ PerlLIO_close(fd[1]);
goto badexit;
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
GV *gv;
IO *io;
PerlIO *fp;
- MAGIC *mg;
SV *discp = NULL;
if (MAXARG < 1)
gv = (GV*)POPs;
- if (gv && (io = GvIO(gv))
- && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
- {
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)io, mg));
- if (discp)
- XPUSHs(discp);
- PUTBACK;
- ENTER;
- call_method("BINMODE", G_SCALAR);
- LEAVE;
- SPAGAIN;
- RETURN;
+ if (gv && (io = GvIO(gv))) {
+ MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ if (mg) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)io, mg));
+ if (discp)
+ XPUSHs(discp);
+ PUTBACK;
+ ENTER;
+ call_method("BINMODE", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ RETURN;
+ }
}
EXTEND(SP, 1);
{
dVAR; dSP; dTARGET;
HV *hv;
- GV * const newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL;
+ GV * const newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : NULL;
GV * egv = GvEGV(PL_defoutgv);
if (!egv)
{
dVAR; dSP; dTARGET;
IO *io = NULL;
- MAGIC *mg;
GV * const gv = (MAXARG==0) ? PL_stdingv : (GV*)POPs;
- if (gv && (io = GvIO(gv))
- && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
- {
- const I32 gimme = GIMME_V;
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)io, mg));
- PUTBACK;
- ENTER;
- call_method("GETC", gimme);
- LEAVE;
- SPAGAIN;
- if (gimme == G_SCALAR)
- SvSetMagicSV_nosteal(TARG, TOPs);
- RETURN;
+ if (gv && (io = GvIO(gv))) {
+ MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ if (mg) {
+ const I32 gimme = GIMME_V;
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)io, mg));
+ PUTBACK;
+ ENTER;
+ call_method("GETC", gimme);
+ LEAVE;
+ SPAGAIN;
+ if (gimme == G_SCALAR)
+ SvSetMagicSV_nosteal(TARG, TOPs);
+ RETURN;
+ }
}
if (!gv || do_eof(gv)) { /* make sure we have fp with something */
if ((!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY))
else
fgv = gv;
- if (!fgv) {
- DIE(aTHX_ "Not a format reference");
- }
+ if (!fgv)
+ goto not_a_format_reference;
+
cv = GvFORM(fgv);
if (!cv) {
SV * const tmpsv = sv_newmortal();
name = SvPV_nolen_const(tmpsv);
if (name && *name)
DIE(aTHX_ "Undefined format \"%s\" called", name);
+
+ not_a_format_reference:
DIE(aTHX_ "Not a format reference");
}
if (CvCLONE(cv))
IO *io;
PerlIO *fp;
SV *sv;
- MAGIC *mg;
GV * const gv = (PL_op->op_flags & OPf_STACKED) ? (GV*)*++MARK : PL_defoutgv;
- if (gv && (io = GvIO(gv))
- && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
- {
- if (MARK == ORIGMARK) {
- MEXTEND(SP, 1);
- ++MARK;
- Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
- ++SP;
+ if (gv && (io = GvIO(gv))) {
+ MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ if (mg) {
+ if (MARK == ORIGMARK) {
+ MEXTEND(SP, 1);
+ ++MARK;
+ Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
+ ++SP;
+ }
+ PUSHMARK(MARK - 1);
+ *MARK = SvTIED_obj((SV*)io, mg);
+ PUTBACK;
+ ENTER;
+ call_method("PRINTF", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ MARK = ORIGMARK + 1;
+ *MARK = *SP;
+ SP = MARK;
+ RETURN;
}
- PUSHMARK(MARK - 1);
- *MARK = SvTIED_obj((SV*)io, mg);
- PUTBACK;
- ENTER;
- call_method("PRINTF", G_SCALAR);
- LEAVE;
- SPAGAIN;
- MARK = ORIGMARK + 1;
- *MARK = *SP;
- SP = MARK;
- RETURN;
}
sv = newSV(0);
SSize_t retval;
STRLEN blen;
STRLEN orig_blen_bytes;
- MAGIC *mg;
const int op_type = PL_op->op_type;
bool doing_utf8;
U8 *tmpbuf = NULL;
GV *const gv = (GV*)*++MARK;
if (PL_op->op_type == OP_SYSWRITE
- && gv && (io = GvIO(gv))
- && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
- {
- SV *sv;
+ && gv && (io = GvIO(gv))) {
+ MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ if (mg) {
+ SV *sv;
- if (MARK == SP - 1) {
- EXTEND(SP, 1000);
- sv = sv_2mortal(newSViv(sv_len(*SP)));
+ if (MARK == SP - 1) {
+ EXTEND(SP, 1000);
+ sv = sv_2mortal(newSViv(sv_len(*SP)));
+ PUSHs(sv);
+ PUTBACK;
+ }
+
+ PUSHMARK(ORIGMARK);
+ *(ORIGMARK+1) = SvTIED_obj((SV*)io, mg);
+ ENTER;
+ call_method("WRITE", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ sv = POPs;
+ SP = ORIGMARK;
PUSHs(sv);
- PUTBACK;
+ RETURN;
}
-
- PUSHMARK(ORIGMARK);
- *(ORIGMARK+1) = SvTIED_obj((SV*)io, mg);
- ENTER;
- call_method("WRITE", G_SCALAR);
- LEAVE;
- SPAGAIN;
- sv = POPs;
- SP = ORIGMARK;
- PUSHs(sv);
- RETURN;
}
if (!gv)
goto say_undef;
}
else if (doing_utf8) {
STRLEN tmplen = blen;
- U8 *result = bytes_from_utf8((const U8*) buffer, &tmplen, &doing_utf8);
+ U8 * const result = bytes_from_utf8((const U8*) buffer, &tmplen, &doing_utf8);
if (!doing_utf8) {
tmpbuf = result;
buffer = (char *) tmpbuf;
/* Don't call sv_len_utf8 again because it will call magic
or overloading a second time, and we might get back a
different result. */
- blen_chars = utf8_length(buffer, buffer + blen);
+ blen_chars = utf8_length((U8*)buffer, (U8*)buffer + blen);
} else {
/* It's safe, and it may well be cached. */
blen_chars = sv_len_utf8(bufsv);
if (doing_utf8)
retval = utf8_length((U8*)buffer, (U8*)buffer + retval);
- if (tmpbuf)
- Safefree(tmpbuf);
+ Safefree(tmpbuf);
#if Size_t_size > IVSIZE
PUSHn(retval);
#else
RETURN;
say_undef:
- if (tmpbuf)
- Safefree(tmpbuf);
+ Safefree(tmpbuf);
SP = ORIGMARK;
RETPUSHUNDEF;
}
dVAR; dSP; dTARGET;
GV *gv;
IO *io;
- MAGIC *mg;
if (MAXARG != 0)
PL_last_in_gv = (GV*)POPs;
gv = PL_last_in_gv;
- if (gv && (io = GvIO(gv))
- && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
- {
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)io, mg));
- PUTBACK;
- ENTER;
- call_method("TELL", G_SCALAR);
- LEAVE;
- SPAGAIN;
- RETURN;
+ if (gv && (io = GvIO(gv))) {
+ MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ if (mg) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)io, mg));
+ PUTBACK;
+ ENTER;
+ call_method("TELL", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ RETURN;
+ }
}
#if LSEEKSIZE > IVSIZE
PP(pp_sysseek)
{
dVAR; dSP;
- IO *io;
const int whence = POPi;
#if LSEEKSIZE > IVSIZE
const Off_t offset = (Off_t)SvNVx(POPs);
#else
const Off_t offset = (Off_t)SvIVx(POPs);
#endif
- MAGIC *mg;
GV * const gv = PL_last_in_gv = (GV*)POPs;
+ IO *io;
- if (gv && (io = GvIO(gv))
- && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
- {
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)io, mg));
+ if (gv && (io = GvIO(gv))) {
+ MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ if (mg) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)io, mg));
#if LSEEKSIZE > IVSIZE
- XPUSHs(sv_2mortal(newSVnv((NV) offset)));
+ XPUSHs(sv_2mortal(newSVnv((NV) offset)));
#else
- XPUSHs(sv_2mortal(newSViv(offset)));
+ XPUSHs(sv_2mortal(newSViv(offset)));
#endif
- XPUSHs(sv_2mortal(newSViv(whence)));
- PUTBACK;
- ENTER;
- call_method("SEEK", G_SCALAR);
- LEAVE;
- SPAGAIN;
- RETURN;
+ XPUSHs(sv_2mortal(newSViv(whence)));
+ PUTBACK;
+ ENTER;
+ call_method("SEEK", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ RETURN;
+ }
}
if (PL_op->op_type == OP_SEEK)
GV * const gv = (GV*)POPs;
register IO * const io = GvIOn(gv);
STRLEN len;
- int bind_ok = 0;
if (!io || !IoIFP(io))
goto nuts;
addr = SvPV_const(addrsv, len);
TAINT_PROPER("bind");
- if (PerlSock_bind(PerlIO_fileno(IoIFP(io)),
- (struct sockaddr *)addr, len) >= 0)
- bind_ok = 1;
-
-
- if (bind_ok)
+ if (PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
RETPUSHYES;
else
RETPUSHUNDEF;
SvTAINTED_on(sv);
#endif
XPUSHs(sv_2mortal(sv));
- }
- while (gimme == G_ARRAY);
+ } while (gimme == G_ARRAY);
if (!dp && gimme != G_ARRAY)
goto nope;
if (hent) {
PUSHs(sv_2mortal(newSVpv((char*)hent->h_name, 0)));
- PUSHs(S_space_join_names_mortal(aTHX_ hent->h_aliases));
+ PUSHs(space_join_names_mortal(hent->h_aliases));
PUSHs(sv_2mortal(newSViv((IV)hent->h_addrtype)));
len = hent->h_length;
PUSHs(sv_2mortal(newSViv((IV)len)));
if (nent) {
PUSHs(sv_2mortal(newSVpv(nent->n_name, 0)));
- PUSHs(S_space_join_names_mortal(aTHX_ nent->n_aliases));
+ PUSHs(space_join_names_mortal(nent->n_aliases));
PUSHs(sv_2mortal(newSViv((IV)nent->n_addrtype)));
PUSHs(sv_2mortal(newSViv((IV)nent->n_net)));
}
if (pent) {
PUSHs(sv_2mortal(newSVpv(pent->p_name, 0)));
- PUSHs(S_space_join_names_mortal(aTHX_ pent->p_aliases));
+ PUSHs(space_join_names_mortal(pent->p_aliases));
PUSHs(sv_2mortal(newSViv((IV)pent->p_proto)));
}
if (sent) {
PUSHs(sv_2mortal(newSVpv(sent->s_name, 0)));
- PUSHs(S_space_join_names_mortal(aTHX_ sent->s_aliases));
+ PUSHs(space_join_names_mortal(sent->s_aliases));
#ifdef HAS_NTOHS
PUSHs(sv_2mortal(newSViv((IV)PerlSock_ntohs(sent->s_port))));
#else
* but the gr_mem is poisonous anyway.
* So yes, you cannot get the list of group
* members if building multithreaded in UNICOS/mk. */
- PUSHs(S_space_join_names_mortal(aTHX_ grent->gr_mem));
+ PUSHs(space_join_names_mortal(grent->gr_mem));
#endif
}