/* pp_sys.c
*
- * Copyright (c) 1991-2000, Larry Wall
+ * Copyright (c) 1991-2001, 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.
PP(pp_open)
{
- djSP; dTARGET;
+ djSP;
+ dMARK; dORIGMARK;
+ dTARGET;
GV *gv;
SV *sv;
SV *name = Nullsv;
char *tmps;
STRLEN len;
MAGIC *mg;
+ bool ok;
- if (MAXARG > 2) {
- name = POPs;
- have_name = 1;
- }
- if (MAXARG > 1)
- sv = POPs;
- if (!isGV(TOPs))
- DIE(aTHX_ PL_no_usym, "filehandle");
- if (MAXARG <= 1)
- sv = GvSV(TOPs);
- gv = (GV*)POPs;
+ gv = (GV *)*++MARK;
if (!isGV(gv))
DIE(aTHX_ PL_no_usym, "filehandle");
if (GvIOp(gv))
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)gv, mg));
- XPUSHs(sv);
- if (have_name)
- XPUSHs(name);
+ /* Method's args are same as ours ... */
+ /* ... except handle is replaced by the object */
+ *MARK-- = SvTIED_obj((SV*)gv, mg);
+ PUSHMARK(MARK);
PUTBACK;
ENTER;
call_method("OPEN", G_SCALAR);
RETURN;
}
+ if (MARK < SP) {
+ sv = *++MARK;
+ }
+ else {
+ sv = GvSV(gv);
+ }
+
tmps = SvPV(sv, len);
- if (do_open9(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, name, have_name))
+ ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK));
+ SP = ORIGMARK;
+ if (ok)
PUSHi( (I32)PL_forkprocess );
else if (PL_forkprocess == 0) /* we are a new child */
PUSHi(0);
RETURN;
}
- if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
+ if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) {
+ /* Can't do this because people seem to do things like
+ defined(fileno($foo)) to check whether $foo is a valid fh.
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
+ */
RETPUSHUNDEF;
+ }
+
PUSHi(PerlIO_fileno(fp));
RETURN;
}
EXTEND(SP, 1);
if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) {
- report_evil_fh(gv, io, PL_op->op_type);
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
RETPUSHUNDEF;
}
DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n",
(long)IoLINES_LEFT(io), (long)FmLINES(PL_formtarget)));
+ if (!io || !ofp)
+ goto forget_top;
if (IoLINES_LEFT(io) < FmLINES(PL_formtarget) &&
PL_formtarget != PL_toptarget)
{
PUSHs(&PL_sv_yes);
}
}
+bad_ofp:
PL_formtarget = PL_bodytarget;
PUTBACK;
return pop_return();
char *s;
IV retval;
GV *gv = (GV*)POPs;
- IO *io = GvIOn(gv);
+ IO *io = gv ? GvIOn(gv) : 0;
if (!io || !argsv || !IoIFP(io)) {
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
SETERRNO(EBADF,RMS$_IFI); /* well, sort of... */
RETPUSHUNDEF;
}
int fd;
gv = (GV*)POPs;
+ io = gv ? GvIOn(gv) : NULL;
- if (!gv) {
+ if (!gv || !io) {
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
+ if (IoIFP(io))
+ do_close(gv, FALSE);
SETERRNO(EBADF,LIB$_INVARG);
RETPUSHUNDEF;
}
- io = GvIOn(gv);
- if (IoIFP(io))
- do_close(gv, FALSE);
-
TAINT_PROPER("socket");
fd = PerlSock_socket(domain, type, protocol);
if (fd < 0)
gv2 = (GV*)POPs;
gv1 = (GV*)POPs;
- if (!gv1 || !gv2)
+ io1 = gv1 ? GvIOn(gv1) : NULL;
+ io2 = gv2 ? GvIOn(gv2) : NULL;
+ if (!gv1 || !gv2 || !io1 || !io2) {
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
+ if (!gv1 || !io1)
+ report_evil_fh(gv1, io1, PL_op->op_type);
+ if (!gv2 || !io2)
+ report_evil_fh(gv1, io2, PL_op->op_type);
+ }
+ if (IoIFP(io1))
+ do_close(gv1, FALSE);
+ if (IoIFP(io2))
+ do_close(gv2, FALSE);
RETPUSHUNDEF;
-
- io1 = GvIOn(gv1);
- io2 = GvIOn(gv2);
- if (IoIFP(io1))
- do_close(gv1, FALSE);
- if (IoIFP(io2))
- do_close(gv2, FALSE);
+ }
TAINT_PROPER("socketpair");
if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
#ifdef HAS_SOCKET
int backlog = POPi;
GV *gv = (GV*)POPs;
- register IO *io = GvIOn(gv);
+ register IO *io = gv ? GvIOn(gv) : NULL;
- if (!io || !IoIFP(io))
+ if (!gv || !io || !IoIFP(io))
goto nuts;
if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
continue;
#endif
/* utf8 characters don't count as odd */
- if (*s & 0x40) {
+ if (UTF8_IS_START(*s)) {
int ulen = UTF8SKIP(s);
if (ulen < len - i) {
int j;
for (j = 1; j < ulen; j++) {
- if ((s[j] & 0xc0) != 0x80)
+ if (!UTF8_IS_CONTINUATION(s[j]))
goto not_utf8;
}
--ulen; /* loop does extra increment */
#ifndef HAS_MKDIR
int oldumask;
#endif
- STRLEN n_a;
+ STRLEN len;
char *tmps;
+ bool copy = FALSE;
if (MAXARG > 1)
mode = POPi;
else
mode = 0777;
- tmps = SvPV(TOPs, n_a);
+ tmps = SvPV(TOPs, len);
+ /* Different operating and file systems take differently to
+ * trailing slashes. According to POSIX 1003.1 1996 Edition
+ * any number of trailing slashes should be allowed.
+ * Thusly we snip them away so that even non-conforming
+ * systems are happy. */
+ /* We should probably do this "filtering" for all
+ * the functions that expect (potentially) directory names:
+ * -d, chdir(), chmod(), chown(), chroot(), fcntl()?,
+ * (mkdir()), opendir(), rename(), rmdir(), stat(). --jhi */
+ if (len > 1 && tmps[len-1] == '/') {
+ while (tmps[len] == '/' && len > 1)
+ len--;
+ tmps = savepvn(tmps, len);
+ copy = TRUE;
+ }
TAINT_PROPER("mkdir");
#ifdef HAS_MKDIR
PerlLIO_umask(oldumask);
PerlLIO_chmod(tmps, (mode & ~oldumask) & 0777);
#endif
+ if (copy)
+ Safefree(tmps);
RETURN;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff