if (IoIFP(io)) {
fd = PerlIO_fileno(IoIFP(io));
- if (IoTYPE(io) == '-')
+ if (IoTYPE(io) == IoTYPE_STD)
result = 0;
else if (fd <= PL_maxsysfd) {
saveifp = IoIFP(io);
savetype = IoTYPE(io);
result = 0;
}
- else if (IoTYPE(io) == '|')
+ else if (IoTYPE(io) == IoTYPE_PIPE)
result = PerlProc_pclose(IoIFP(io));
else if (IoIFP(io) != IoOFP(io)) {
if (IoOFP(io)) {
switch (result = rawmode & O_ACCMODE) {
case O_RDONLY:
- IoTYPE(io) = '<';
+ IoTYPE(io) = IoTYPE_RDONLY;
break;
case O_WRONLY:
- IoTYPE(io) = '>';
+ IoTYPE(io) = IoTYPE_WRONLY;
break;
case O_RDWR:
default:
- IoTYPE(io) = '+';
+ IoTYPE(io) = IoTYPE_RDWR;
break;
}
TAINT_PROPER("open");
type++;
if (*type == '>') {
- mode[0] = IoTYPE(io) = 'a';
+ mode[0] = IoTYPE(io) = IoTYPE_APPEND;
type++;
tlen--;
}
* fsetpos(src)+fgetpos(dst)? --nik */
PerlIO_flush(fp);
fd = PerlIO_fileno(fp);
- if (IoTYPE(thatio) == 's')
- IoTYPE(io) = 's';
+ if (IoTYPE(thatio) == IoTYPE_SOCKET)
+ IoTYPE(io) = IoTYPE_SOCKET;
}
else
fd = -1;
for (; isSPACE(*type); type++) ;
if (strEQ(type,"-")) {
fp = PerlIO_stdout();
- IoTYPE(io) = '-';
+ IoTYPE(io) = IoTYPE_STD;
}
else {
fp = PerlIO_open((num_svs ? name : type), mode);
}
if (strEQ(type,"-")) {
fp = PerlIO_stdin();
- IoTYPE(io) = '-';
+ IoTYPE(io) = IoTYPE_STD;
}
else
fp = PerlIO_open((num_svs ? name : type), mode);
mode = "r";
fp = PerlProc_popen(name,mode);
}
- IoTYPE(io) = '|';
+ IoTYPE(io) = IoTYPE_PIPE;
}
else {
if (num_svs)
goto unknown_desr;
name = type;
- IoTYPE(io) = '<';
+ IoTYPE(io) = IoTYPE_RDONLY;
/*SUPPRESS 530*/
for (; isSPACE(*name); name++) ;
if (strEQ(name,"-")) {
fp = PerlIO_stdin();
- IoTYPE(io) = '-';
+ IoTYPE(io) = IoTYPE_STD;
}
else {
char *mode;
}
if (!fp) {
dTHR;
- if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == '<' && strchr(name, '\n'))
+ if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n'))
Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
goto say_false;
}
if (IoTYPE(io) &&
- IoTYPE(io) != '|' && IoTYPE(io) != '-') {
+ IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) {
dTHR;
if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) {
(void)PerlIO_close(fp);
goto say_false;
}
if (S_ISSOCK(PL_statbuf.st_mode))
- IoTYPE(io) = 's'; /* in case a socket was passed in to us */
+ IoTYPE(io) = IoTYPE_SOCKET; /* in case a socket was passed in to us */
#ifdef HAS_SOCKET
else if (
#ifdef S_IFMT
if (PerlSock_getsockname(PerlIO_fileno(fp), (struct sockaddr *)tmpbuf,
&buflen) >= 0
|| errno != ENOTSOCK)
- IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
+ IoTYPE(io) = IoTYPE_SOCKET; /* some OS's return 0 on fstat()ed socket */
/* but some return 0 for streams too, sigh */
}
#endif
SV *sv;
PerlLIO_dup2(PerlIO_fileno(fp), fd);
- FDPID_LOCK();
+ LOCK_FDPID_MUTEX;
sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
(void)SvUPGRADE(sv, SVt_IV);
pid = SvIVX(sv);
SvIVX(sv) = 0;
sv = *av_fetch(PL_fdpid,fd,TRUE);
- FDPID_UNLOCK();
+ UNLOCK_FDPID_MUTEX;
(void)SvUPGRADE(sv, SVt_IV);
SvIVX(sv) = pid;
if (!was_fdopen)
IoFLAGS(io) &= ~IOf_NOLINE;
if (writing) {
dTHR;
- if (IoTYPE(io) == 's'
- || (IoTYPE(io) == '>' && S_ISCHR(PL_statbuf.st_mode)) )
+ if (IoTYPE(io) == IoTYPE_SOCKET
+ || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) )
{
char *mode;
if (out_raw)
IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
IoIFP(wstio) = IoOFP(wstio);
- IoTYPE(rstio) = '<';
- IoTYPE(wstio) = '>';
+ IoTYPE(rstio) = IoTYPE_RDONLY;
+ IoTYPE(wstio) = IoTYPE_WRONLY;
if (!IoIFP(rstio) || !IoOFP(wstio)) {
if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
else PerlLIO_close(fd[0]);
if (!io) { /* never opened */
if (not_implicit) {
dTHR;
- if (ckWARN(WARN_UNOPENED))
- Perl_warner(aTHX_ WARN_UNOPENED,
- "Close on unopened file <%s>",GvENAME(gv));
+ if (ckWARN(WARN_UNOPENED)) /* no check for closed here */
+ report_evil_fh(gv, io, PL_op->op_type);
SETERRNO(EBADF,SS$_IVCHAN);
}
return FALSE;
IoPAGE(io) = 0;
IoLINES_LEFT(io) = IoPAGE_LEN(io);
}
- IoTYPE(io) = ' ';
+ IoTYPE(io) = IoTYPE_CLOSED;
return retval;
}
int status;
if (IoIFP(io)) {
- if (IoTYPE(io) == '|') {
+ if (IoTYPE(io) == IoTYPE_PIPE) {
status = PerlProc_pclose(IoIFP(io));
if (not_implicit) {
STATUS_NATIVE_SET(status);
retval = (status != -1);
}
}
- else if (IoTYPE(io) == '-')
+ else if (IoTYPE(io) == IoTYPE_STD)
retval = TRUE;
else {
if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { /* a socket */
if (!io)
return TRUE;
else if (ckWARN(WARN_IO)
- && (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+ && (IoTYPE(io) == IoTYPE_WRONLY || IoIFP(io) == PerlIO_stdout()
|| IoIFP(io) == PerlIO_stderr()))
{
- SV* sv = sv_newmortal();
- gv_efullname3(sv, gv, Nullch);
- Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
- SvPV_nolen(sv));
+ /* integrate to report_evil_fh()? */
+ char *name = NULL;
+ if (isGV(gv)) {
+ SV* sv = sv_newmortal();
+ gv_efullname4(sv, gv, Nullch, FALSE);
+ name = SvPV_nolen(sv);
+ }
+ if (name && *name)
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for output", name);
+ else
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle opened only for output");
}
while (IoIFP(io)) {
}
{
dTHR;
- if (ckWARN(WARN_UNOPENED))
- Perl_warner(aTHX_ WARN_UNOPENED, "tell() on unopened file");
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
}
SETERRNO(EBADF,RMS$_IFI);
return (Off_t)-1;
}
{
dTHR;
- if (ckWARN(WARN_UNOPENED))
- Perl_warner(aTHX_ WARN_UNOPENED, "seek() on unopened file");
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
}
SETERRNO(EBADF,RMS$_IFI);
return FALSE;
return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
{
dTHR;
- if (ckWARN(WARN_UNOPENED))
- Perl_warner(aTHX_ WARN_UNOPENED, "sysseek() on unopened file");
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
}
SETERRNO(EBADF,RMS$_IFI);
return (Off_t)-1;
{
djSP;
IO *io;
- GV* tmpgv;
+ GV* gv;
if (PL_op->op_flags & OPf_REF) {
EXTEND(SP,1);
- tmpgv = cGVOP_gv;
+ gv = cGVOP_gv;
do_fstat:
- io = GvIO(tmpgv);
+ io = GvIO(gv);
if (io && IoIFP(io)) {
- PL_statgv = tmpgv;
+ PL_statgv = gv;
sv_setpv(PL_statname,"");
PL_laststype = OP_STAT;
return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
}
else {
- if (tmpgv == PL_defgv)
+ if (gv == PL_defgv)
return PL_laststatval;
- if (ckWARN(WARN_UNOPENED))
- Perl_warner(aTHX_ WARN_UNOPENED, "Stat on unopened file <%s>",
- GvENAME(tmpgv));
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
PL_statgv = Nullgv;
sv_setpv(PL_statname,"");
return (PL_laststatval = -1);
STRLEN n_a;
PUTBACK;
if (SvTYPE(sv) == SVt_PVGV) {
- tmpgv = (GV*)sv;
+ gv = (GV*)sv;
goto do_fstat;
}
else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
- tmpgv = (GV*)SvRV(sv);
+ gv = (GV*)SvRV(sv);
goto do_fstat;
}
id = SvIVx(*++mark);
mstr = *++mark;
+ /* suppress warning when reading into undef var --jhi */
+ if (! SvOK(mstr))
+ sv_setpvn(mstr, "", 0);
msize = SvIVx(*++mark);
mtype = (long)SvIVx(*++mark);
flags = SvIVx(*++mark);