/* pp_sys.c
*
- * Copyright (c) 1991-1999, Larry Wall
+ * Copyright (c) 1991-2000, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
compiling multithreaded and singlethreaded ($ccflags et al).
HOST_NOT_FOUND is typically defined in <netdb.h>.
*/
-#if defined(HOST_NOT_FOUND) && !defined(h_errno)
+#if defined(HOST_NOT_FOUND) && !defined(h_errno) && !defined(__CYGWIN__)
extern int h_errno;
#endif
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26));
- Perl_warn(aTHX_ "%_", tmpsv);
+ Perl_warn(aTHX_ "%"SVf, tmpsv);
RETSETYES;
}
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvn("Died", 4));
- DIE(aTHX_ "%_", tmpsv);
+ DIE(aTHX_ "%"SVf, tmpsv);
}
/* I/O. */
gv = PL_stdingv;
else
gv = (GV*)POPs;
- if (!gv)
- gv = PL_argvgv;
if (mg = SvTIED_mg((SV*)gv, 'q')) {
I32 gimme = GIMME_V;
fp = IoOFP(io);
if (!fp) {
if (ckWARN2(WARN_CLOSED,WARN_IO)) {
- SV* sv = sv_newmortal();
- gv_efullname3(sv, gv, Nullch);
- if (IoIFP(io))
+ if (IoIFP(io)) {
+ SV* sv = sv_newmortal();
+ gv_efullname3(sv, gv, Nullch);
Perl_warner(aTHX_ WARN_IO,
"Filehandle %s opened only for input",
SvPV_nolen(sv));
+ }
else if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED,
- "write() on closed filehandle %s", SvPV_nolen(sv));
+ report_closed_fh(gv, io, "write", "filehandle");
}
PUSHs(&PL_sv_no);
}
}
else if (!(fp = IoOFP(io))) {
if (ckWARN2(WARN_CLOSED,WARN_IO)) {
- gv_efullname3(sv, gv, Nullch);
- if (IoIFP(io))
+ if (IoIFP(io)) {
+ gv_efullname3(sv, gv, Nullch);
Perl_warner(aTHX_ WARN_IO,
"Filehandle %s opened only for input",
SvPV(sv,n_a));
+ }
else if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED,
- "printf() on closed filehandle %s", SvPV(sv,n_a));
+ report_closed_fh(gv, io, "printf", "filehandle");
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
length = -1;
if (ckWARN(WARN_CLOSED)) {
if (PL_op->op_type == OP_SYSWRITE)
- Perl_warner(aTHX_ WARN_CLOSED, "syswrite() on closed filehandle");
+ report_closed_fh(gv, io, "syswrite", "filehandle");
else
- Perl_warner(aTHX_ WARN_CLOSED, "send() on closed socket");
+ report_closed_fh(gv, io, "send", "socket");
}
}
else if (PL_op->op_type == OP_SYSWRITE) {
if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
+#if LSEEKSIZE > IVSIZE
+ XPUSHs(sv_2mortal(newSVnv((NV) offset)));
+#else
XPUSHs(sv_2mortal(newSViv((IV) offset)));
+#endif
XPUSHs(sv_2mortal(newSViv((IV) whence)));
PUTBACK;
ENTER;
tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
do_ftruncate:
TAINT_PROPER("truncate");
- if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
+ if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)))
+ result = 0;
+ else {
+ PerlIO_flush(IoIFP(GvIOp(tmpgv)));
#ifdef HAS_TRUNCATE
- ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+ if (ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
#else
- my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+ if (my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
#endif
- result = 0;
+ result = 0;
+ }
}
else {
SV *sv = POPs;
(void)PerlIO_flush(fp);
value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0);
}
- else
+ else {
value = 0;
+ SETERRNO(EBADF,RMS$_IFI);
+ if (ckWARN(WARN_CLOSED))
+ report_closed_fh(gv, GvIO(gv), "flock", "filehandle");
+ }
PUSHi(value);
RETURN;
#else
nuts:
if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed socket");
+ report_closed_fh(gv, io, "bind", "socket");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
nuts:
if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed socket");
+ report_closed_fh(gv, io, "connect", "socket");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
nuts:
if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed socket");
+ report_closed_fh(gv, io, "listen", "socket");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
nuts:
if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed socket");
+ report_closed_fh(ggv, ggv ? GvIO(ggv) : 0, "accept", "socket");
SETERRNO(EBADF,SS$_IVCHAN);
badexit:
nuts:
if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed socket");
+ report_closed_fh(gv, io, "shutdown", "socket");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
nuts:
if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED, "%cetsockopt() on closed socket",
- optype == OP_GSOCKOPT ? 'g' : 's');
+ report_closed_fh(gv, io,
+ optype == OP_GSOCKOPT ? "getsockopt" : "setsockopt",
+ "socket");
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
nuts:
if (ckWARN(WARN_CLOSED))
- Perl_warner(aTHX_ WARN_CLOSED, "get%sname() on closed socket",
- optype == OP_GETSOCKNAME ? "sock" : "peer");
+ report_closed_fh(gv, io,
+ optype == OP_GETSOCKNAME ? "getsockname"
+ : "getpeername",
+ "socket");
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;