/* pp_sys.c
*
- * Copyright (c) 1991-2001, Larry Wall
+ * Copyright (c) 1991-2002, 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.
SV *obj = SvRV(mg->mg_obj);
GV *gv;
CV *cv = NULL;
- if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
- isGV(gv) && (cv = GvCV(gv))) {
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
- XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
- PUTBACK;
- ENTER;
- call_sv((SV *)cv, G_VOID);
- LEAVE;
- SPAGAIN;
- }
- else if (ckWARN(WARN_UNTIE)) {
- if (mg && SvREFCNT(obj) > 1)
- Perl_warner(aTHX_ WARN_UNTIE,
- "untie attempted while %"UVuf" inner references still exist",
- (UV)SvREFCNT(obj) - 1 ) ;
+ if (obj) {
+ if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
+ isGV(gv) && (cv = GvCV(gv))) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)gv, mg));
+ XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
+ PUTBACK;
+ ENTER;
+ call_sv((SV *)cv, G_VOID);
+ LEAVE;
+ SPAGAIN;
+ }
+ else if (ckWARN(WARN_UNTIE)) {
+ if (mg && SvREFCNT(obj) > 1)
+ Perl_warner(aTHX_ WARN_UNTIE,
+ "untie attempted while %"UVuf" inner references still exist",
+ (UV)SvREFCNT(obj) - 1 ) ;
+ }
}
- sv_unmagic(sv, how);
+ sv_unmagic(sv, how) ;
}
RETPUSHYES;
}
Size_t got = 0;
Size_t wanted;
bool charstart = FALSE;
- STRLEN skip;
- STRLEN charskip;
+ STRLEN charskip = 0;
+ STRLEN skip = 0;
gv = (GV*)*++MARK;
if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
charstart = TRUE;
charskip = 0;
+ skip = 0;
#ifdef HAS_SOCKET
if (PL_op->op_type == OP_RECV) {
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;
PP(pp_sockpair)
{
-#ifdef HAS_SOCKETPAIR
+#if defined (HAS_SOCKETPAIR) || defined (HAS_SOCKET)
dSP;
GV *gv1;
GV *gv2;
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;
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
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);
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