SV *tmpsv;
STRLEN len;
bool multiarg = 0;
+#ifdef VMS
+ VMSISH_HUSHED = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
+#endif
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
if (!(io = GvIO(gv))) {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
else if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
}
- SETERRNO(EBADF,IoIFP(io)?VMS_RMS_FAC:VMS_RMS_IFI);
+ SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
}
else {
int fp_utf8;
Size_t got = 0;
Size_t wanted;
+ bool charstart = FALSE;
+ STRLEN charskip = 0;
+ STRLEN skip = 0;
gv = (GV*)*++MARK;
if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
DIE(aTHX_ "Negative length");
wanted = length;
+ charstart = TRUE;
+ charskip = 0;
+ skip = 0;
+
#ifdef HAS_SOCKET
if (PL_op->op_type == OP_RECV) {
char namebuf[MAXPATHLEN];
/* Look at utf8 we got back and count the characters */
char *bend = buffer + count;
while (buffer < bend) {
- STRLEN skip = UTF8SKIP(buffer);
- if (buffer+skip > bend) {
+ if (charstart) {
+ skip = UTF8SKIP(buffer);
+ charskip = 0;
+ }
+ if (buffer - charskip + skip > bend) {
/* partial character - try for rest of it */
length = skip - (bend-buffer);
offset = bend - SvPVX(bufsv);
+ charstart = FALSE;
+ charskip += count;
goto more_bytes;
}
else {
got++;
buffer += skip;
+ charstart = TRUE;
+ charskip = 0;
}
}
/* If we have not 'got' the number of _characters_ we 'wanted' get some more
provided amount read (count) was what was requested (length)
*/
if (got < wanted && count == length) {
- length = (wanted-got);
+ length = wanted - got;
offset = bend - SvPVX(bufsv);
goto more_bytes;
}
if (retval < 0)
goto say_undef;
SP = ORIGMARK;
+ if (DO_UTF8(bufsv))
+ retval = utf8_length((U8*)buffer, (U8*)buffer + retval);
#if Size_t_size > IVSIZE
PUSHn(retval);
#else
else {
SV *sv = POPs;
char *name;
-
+
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv; /* *main::FRED for example */
goto do_ftruncate;
if (result)
RETPUSHYES;
if (!errno)
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
}
#else
if (!io || !argsv || !IoIFP(io)) {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_RMS_IFI); /* well, sort of... */
+ SETERRNO(EBADF,RMS$_IFI); /* well, sort of... */
RETPUSHUNDEF;
}
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
value = 0;
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
}
PUSHi(value);
RETURN;
report_evil_fh(gv, io, PL_op->op_type);
if (IoIFP(io))
do_close(gv, FALSE);
- SETERRNO(EBADF,VMS_LIB_INVARG);
+ SETERRNO(EBADF,LIB$_INVARG);
RETPUSHUNDEF;
}
PP(pp_sockpair)
{
-#ifdef HAS_SOCKETPAIR
+#if defined (HAS_SOCKETPAIR) || defined (HAS_SOCKET)
dSP;
GV *gv1;
GV *gv2;
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "bind");
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "connect");
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "listen");
struct sockaddr saddr; /* use a struct to avoid alignment problems */
Sock_size_t len = sizeof saddr;
int fd;
+ int fd2;
ggv = (GV*)POPs;
ngv = (GV*)POPs;
goto nuts;
nstio = GvIOn(ngv);
- if (IoIFP(nstio))
- do_close(ngv, FALSE);
-
fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
if (fd < 0)
goto badexit;
+ if (IoIFP(nstio))
+ do_close(ngv, FALSE);
IoIFP(nstio) = PerlIO_fdopen(fd, "r");
- IoOFP(nstio) = PerlIO_fdopen(fd, "w");
+ /* FIXME: we dup(fd) here so that refcounting of fd's does not inhibit
+ fclose of IoOFP's FILE * - and hence leak memory.
+ Special treatment of _this_ case of IoIFP != IoOFP seems wrong.
+ */
+ IoOFP(nstio) = PerlIO_fdopen(fd2 = PerlLIO_dup(fd), "w");
IoTYPE(nstio) = IoTYPE_SOCKET;
if (!IoIFP(nstio) || !IoOFP(nstio)) {
if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */
+ fcntl(fd2, F_SETFD, fd2 > PL_maxsysfd); /* ensure close-on-exec */
#endif
#ifdef EPOC
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(ggv, ggv ? GvIO(ggv) : 0, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
badexit:
RETPUSHUNDEF;
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "shutdown");
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, optype);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, optype);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
gv = cGVOP_gv;
report_evil_fh(gv, GvIO(gv), PL_op->op_type);
}
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
}
}
deprecate("chdir('') or chdir(undef) as chdir()");
tmps = SvPV(*svp, n_a);
}
- else {
+ else {
PUSHi(0);
+ TAINT_PROPER("chdir");
RETURN;
}
}
PP(pp_link)
{
- dSP;
#ifdef HAS_LINK
- dTARGET;
+ dSP; dTARGET;
STRLEN n_a;
char *tmps2 = POPpx;
char *tmps = SvPV(TOPs, n_a);
RETPUSHYES;
nope:
if (!errno)
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "closedir");
RETSETUNDEF;
if (!childpid) {
/*SUPPRESS 560*/
- if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV)))
+ if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV))) {
+ SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
+ SvREADONLY_on(GvSV(tmpgv));
+ }
hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
}
PUSHi(childpid);
Pid_t childpid;
int status;
Sigsave_t ihand,qhand; /* place to save signals during system() */
-
+
+ if (PL_tainting) {
+ SV *cmd = NULL;
+ if (PL_op->op_flags & OPf_STACKED)
+ cmd = *(MARK + 1);
+ else if (SP - MARK != 1)
+ cmd = *SP;
+ if (cmd && *(SvPV_nolen(cmd)) != '/')
+ TAINT_ENV();
+ }
+
if (PerlProc_pipe(pp) >= 0)
did_pipes = 1;
while ((childpid = PerlProc_fork()) == -1) {
if (did_pipes) {
int errkid;
int n = 0, n1;
-
+
while (n < sizeof(int)) {
n1 = PerlLIO_read(pp[0],
(void*)(((char*)&errkid)+n),
it's supported. --AD 9/96.
*/
+#ifdef __BEOS__
+# define HZ 1000000
+#endif
+
#ifndef HZ
# ifdef CLK_TCK
# define HZ CLK_TCK