/* pp_sys.c
*
- * Copyright (C) 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ * Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+ * 2004, 2005, 2006, 2007 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
return res;
}
-# define PERL_EFF_ACCESS(p,f) (emulate_eaccess((p), (f)))
-#endif
-
-#if !defined(PERL_EFF_ACCESS)
-/* With it or without it: anyway you get a warning: either that
- it is unused, or it is declared static and never defined.
- */
-STATIC int
-S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
-{
- PERL_UNUSED_ARG(path);
- PERL_UNUSED_ARG(mode);
- Perl_croak(aTHX_ "switching effective uid is not implemented");
- /*NOTREACHED*/
- return -1;
-}
+# define PERL_EFF_ACCESS(p,f) (S_emulate_eaccess(aTHX_ (p), (f)))
#endif
PP(pp_backtick)
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);
else if (SP == MARK) {
tmpsv = &PL_sv_no;
EXTEND(SP, 1);
+ SP = MARK + 1;
}
else {
tmpsv = TOPs;
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvs("Warning: something's wrong"));
- Perl_warn(aTHX_ "%"SVf, (void*)tmpsv);
+ Perl_warn(aTHX_ "%"SVf, SVfARG(tmpsv));
RETSETYES;
}
}
else {
tmpsv = TOPs;
- tmps = SvROK(tmpsv) ? NULL : SvPV_const(tmpsv, len);
+ tmps = SvROK(tmpsv) ? (const char *)NULL : SvPV_const(tmpsv, len);
}
if (!tmps || !len) {
SV * const error = ERRSV;
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvs("Died"));
- DIE(aTHX_ "%"SVf, (void*)tmpsv);
+ DIE(aTHX_ "%"SVf, SVfARG(tmpsv));
}
/* I/O. */
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);
+ if (IoDIRP(io) && ckWARN2(WARN_IO, WARN_DEPRECATED))
+ Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+ "Opening dirhandle %s also as a file", GvENAME(gv));
+
+ 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)
Mode_t anum;
if (MAXARG < 1) {
- anum = PerlLIO_umask(0);
- (void)PerlLIO_umask(anum);
+ anum = PerlLIO_umask(022);
+ /* setting it to 022 between the two calls to umask avoids
+ * to have a window where the umask is set to 0 -- meaning
+ * that another thread could create world-writeable files. */
+ if (anum != 022)
+ (void)PerlLIO_umask(anum);
}
else
anum = PerlLIO_umask(POPi);
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);
}
PUTBACK;
- if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
- (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) : NULL)) {
- SPAGAIN;
- RETPUSHUNDEF;
- }
+ {
+ const int mode = mode_from_discipline(discp);
+ const char *const d = (discp ? SvPV_nolen_const(discp) : NULL);
+ if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) {
+ if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
+ if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) {
+ SPAGAIN;
+ RETPUSHUNDEF;
+ }
+ }
+ SPAGAIN;
+ RETPUSHYES;
+ }
+ else {
+ SPAGAIN;
+ RETPUSHUNDEF;
}
- SPAGAIN;
- RETPUSHYES;
- }
- else {
- SPAGAIN;
- RETPUSHUNDEF;
}
}
/* Not clear why we don't call call_method here too.
* perhaps to get different error message ?
*/
- stash = gv_stashsv(*MARK, FALSE);
+ stash = gv_stashsv(*MARK, 0);
if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
- methname, (void*)*MARK);
+ methname, SVfARG(*MARK));
}
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
HV * const hv = (HV*)POPs;
SV * const sv = sv_2mortal(newSVpvs("AnyDBM_File"));
- stash = gv_stashsv(sv, FALSE);
+ stash = gv_stashsv(sv, 0);
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
PUTBACK;
require_pv("AnyDBM_File.pm");
{
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))
register IO *io;
GV *fgv;
CV *cv;
+ SV * tmpsv = NULL;
if (MAXARG == 0)
gv = PL_defoutgv;
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();
const char *name;
+ tmpsv = sv_newmortal();
gv_efullname4(tmpsv, fgv, NULL, FALSE);
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);
goto just_say_no;
}
else {
+ if (SvTAINTED(MARK[1]))
+ TAINT_PROPER("printf");
do_sprintf(sv, SP - MARK, MARK + 1);
if (!do_print(sv, fp))
goto just_say_no;
buffer = SvGROW(bufsv, (STRLEN)(length+1));
/* 'offset' means 'flags' here */
count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
- (struct sockaddr *)namebuf, &bufsize);
+ (struct sockaddr *)namebuf, &bufsize);
if (count < 0)
RETPUSHUNDEF;
#ifdef EPOC
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;
SETERRNO(0,0);
io = GvIO(gv);
- if (!io || !IoIFP(io)) {
+ if (!io || !IoIFP(io) || IoTYPE(io) == IoTYPE_RDONLY) {
retval = -1;
- if (ckWARN(WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
+ if (io && IoIFP(io))
+ report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
+ else
+ report_evil_fh(gv, io, PL_op->op_type);
+ }
SETERRNO(EBADF,RMS_IFI);
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;
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;
}
IoLINES(io) = 0;
IoFLAGS(io) &= ~IOf_START;
do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
- sv_setpvn(GvSV(gv), "-", 1);
+ if ( GvSV(gv) ) {
+ sv_setpvn(GvSV(gv), "-", 1);
+ }
+ else {
+ GvSV(gv) = newSVpvn("-", 1);
+ }
SvSETMAGIC(GvSV(gv));
}
else if (!nextargv(gv))
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;
nstio = GvIOn(ngv);
fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len);
+#if defined(OEMVS)
+ if (len == 0) {
+ /* Some platforms indicate zero length when an AF_UNIX client is
+ * not bound. Simulate a non-zero-length sockaddr structure in
+ * this case. */
+ namebuf[0] = 0; /* sun_len */
+ namebuf[1] = AF_UNIX; /* sun_family */
+ len = 2;
+ }
+#endif
+
if (fd < 0)
goto badexit;
if (IoIFP(nstio))
{
dVAR;
dSP;
- GV *gv;
+ GV *gv = NULL;
+ IO *io;
I32 gimme;
I32 max = 13;
do_fstat_warning_check:
if (ckWARN(WARN_IO))
Perl_warner(aTHX_ packWARN(WARN_IO),
- "lstat() on filehandle %s", GvENAME(gv));
+ "lstat() on filehandle %s", gv ? GvENAME(gv) : "");
} else if (PL_laststype != OP_LSTAT)
Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
}
PL_laststype = OP_STAT;
PL_statgv = gv;
sv_setpvn(PL_statname, "", 0);
- PL_laststatval = (GvIO(gv) && IoIFP(GvIOp(gv))
- ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache) : -1);
- }
+ if(gv) {
+ io = GvIO(gv);
+ do_fstat_have_io:
+ if (io) {
+ if (IoIFP(io)) {
+ PL_laststatval =
+ PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);
+ } else if (IoDIRP(io)) {
+ PL_laststatval =
+ PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
+ } else {
+ PL_laststatval = -1;
+ }
+ }
+ }
+ }
+
if (PL_laststatval < 0) {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, GvIO(gv), PL_op->op_type);
if (SvTYPE(sv) == SVt_PVGV) {
gv = (GV*)sv;
goto do_fstat;
- }
- else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
- gv = (GV*)SvRV(sv);
- if (PL_op->op_type == OP_LSTAT)
- goto do_fstat_warning_check;
- goto do_fstat;
- }
+ } else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+ gv = (GV*)SvRV(sv);
+ if (PL_op->op_type == OP_LSTAT)
+ goto do_fstat_warning_check;
+ goto do_fstat;
+ } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
+ io = (IO*)SvRV(sv);
+ if (PL_op->op_type == OP_LSTAT)
+ goto do_fstat_warning_check;
+ goto do_fstat_have_io;
+ }
+
sv_setpv(PL_statname, SvPV_nolen_const(sv));
PL_statgv = NULL;
PL_laststype = PL_op->op_type;
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime)));
#else
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_atime)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_mtime)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_ctime)));
+ PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_atime)));
+ PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_mtime)));
+ PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_ctime)));
#endif
#ifdef USE_STAT_BLOCKS
PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize)));
if (use_access) {
#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
- const char *const name = POPpx;
+ const char *name = POPpx;
if (effective) {
# ifdef PERL_EFF_ACCESS
result = PERL_EFF_ACCESS(name, access_mode);
#if defined(DOSISH) || defined(USEMYBINMODE)
/* ignore trailing ^Z on short files */
- if (len && len < sizeof(tbuf) && tbuf[len-1] == 26)
+ if (len && len < (I32)sizeof(tbuf) && tbuf[len-1] == 26)
--len;
#endif
gv = (GV*)SvRV(sv);
}
else {
- tmps = SvPVx_nolen_const(sv);
+ tmps = SvPV_nolen_const(sv);
}
}
#ifdef HAS_FCHDIR
IO* const io = GvIO(gv);
if (io) {
- if (IoIFP(io)) {
- PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
- }
- else if (IoDIRP(io)) {
-#ifdef HAS_DIRFD
- PUSHi(fchdir(dirfd(IoDIRP(io))) >= 0);
-#else
- DIE(aTHX_ PL_no_func, "dirfd");
-#endif
+ if (IoDIRP(io)) {
+ PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0);
+ } else if (IoIFP(io)) {
+ PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
}
else {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
char *s;
PerlIO *myfp;
int anum = 1;
+ Size_t size = strlen(cmd) + (strlen(filename) * 2) + 10;
- Newx(cmdline, strlen(cmd) + (strlen(filename) * 2) + 10, char);
- strcpy(cmdline, cmd);
- strcat(cmdline, " ");
+ Newx(cmdline, size, char);
+ my_strlcpy(cmdline, cmd, size);
+ my_strlcat(cmdline, " ", size);
for (s = cmdline + strlen(cmdline); *filename; ) {
*s++ = '\\';
*s++ = *filename++;
}
- strcpy(s, " 2>&1");
+ if (s - cmdline < size)
+ my_strlcpy(s, " 2>&1", size - (s - cmdline));
myfp = PerlProc_popen(cmdline, "r");
Safefree(cmdline);
if (!io)
goto nope;
+ if ((IoIFP(io) || IoOFP(io)) && ckWARN2(WARN_IO, WARN_DEPRECATED))
+ Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+ "Opening filehandle %s also as a directory", GvENAME(gv));
if (IoDIRP(io))
PerlDir_close(IoDIRP(io));
if (!(IoDIRP(io) = PerlDir_open(dirname)))
SvTAINTED_on(sv);
#endif
XPUSHs(sv_2mortal(sv));
- }
- while (gimme == G_ARRAY);
+ } while (gimme == G_ARRAY);
if (!dp && gimme != G_ARRAY)
goto nope;
PP(pp_wait)
{
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
dVAR; dSP; dTARGET;
Pid_t childpid;
int argflags;
PP(pp_waitpid)
{
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
dVAR; dSP; dTARGET;
const int optype = POPi;
const Pid_t pid = TOPi;
PP(pp_system)
{
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+#if defined(__LIBCATAMOUNT__)
+ PL_statusvalue = -1;
+ SP = ORIGMARK;
+ XPUSHi(-1);
+#else
I32 value;
int result;
do_execfree();
SP = ORIGMARK;
XPUSHi(result ? value : STATUS_CURRENT);
-#endif /* !FORK or VMS */
+#endif /* !FORK or VMS or OS/2 */
+#endif
RETURN;
}
const int addrtype = POPi;
SV * const addrsv = POPs;
STRLEN addrlen;
- Netdb_host_t addr = (Netdb_host_t) SvPVbyte(addrsv, addrlen);
+ const char *addr = (char *)SvPVbyte(addrsv, addrlen);
hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
#else
# ifdef PWGECOS
PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_gecos, 0)));
# else
- PUSHs(sv_mortalcopy(&PL_sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
# endif
# ifndef INCOMPLETE_TAINTS
/* pw_gecos is tainted because user himself can diddle with it. */
https://perl5.git.perl.org / perl5.git / blobdiff