X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=d733c3487330e31192d60357990b5537fd2ee91f;hb=80589958147be1b203a8dbab685aa65994207e8a;hp=d80449ed3e53c462839b64cb5504b98a52e36a73;hpb=fd0af264cfc969f4623f421719ccd55177a389c6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index d80449e..d733c34 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -86,23 +86,20 @@ extern int h_errno; #include #endif -#ifdef HAS_GETPGRP2 -# define getpgrp getpgrp2 +#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) +static int dooneliner _((char *cmd, char *filename)); #endif -#ifdef HAS_SETPGRP2 -# define setpgrp setpgrp2 +#ifdef HAS_CHSIZE +# define my_chsize chsize #endif -#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) -static int dooneliner _((char *cmd, char *filename)); -#endif /* Pushy I/O. */ PP(pp_backtick) { dSP; dTARGET; - FILE *fp; + PerlIO *fp; char *tmps = POPp; TAINT_PROPER("``"); fp = my_popen(tmps, "r"); @@ -145,22 +142,18 @@ PP(pp_glob) { OP *result; ENTER; - SAVEINT(rschar); - SAVEINT(rslen); SAVESPTR(last_in_gv); /* We don't want this to be permanent. */ last_in_gv = (GV*)*stack_sp--; - rslen = 1; -#ifdef DOSISH - rschar = 0; -#else -#ifdef CSH - rschar = 0; -#else - rschar = '\n'; + SAVESPTR(rs); /* This is not permanent, either. */ + rs = sv_2mortal(newSVpv("", 1)); +#ifndef DOSISH +#ifndef CSH + *SvPVX(rs) = '\n'; #endif /* !CSH */ #endif /* !MSDOS */ + result = do_readline(); LEAVE; return result; @@ -247,7 +240,7 @@ PP(pp_open) DIE(no_usym, "filehandle"); gv = (GV*)POPs; tmps = SvPV(sv, len); - if (do_open(gv, tmps, len,Nullfp)) { + if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp)) { IoLINES(GvIOp(gv)) = 0; PUSHi( (I32)forkprocess ); } @@ -301,16 +294,16 @@ PP(pp_pipe_op) if (pipe(fd) < 0) goto badexit; - IoIFP(rstio) = fdopen(fd[0], "r"); - IoOFP(wstio) = fdopen(fd[1], "w"); + IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"); + IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"); IoIFP(wstio) = IoOFP(wstio); IoTYPE(rstio) = '<'; IoTYPE(wstio) = '>'; if (!IoIFP(rstio) || !IoOFP(wstio)) { - if (IoIFP(rstio)) fclose(IoIFP(rstio)); + if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio)); else close(fd[0]); - if (IoOFP(wstio)) fclose(IoOFP(wstio)); + if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio)); else close(fd[1]); goto badexit; } @@ -329,13 +322,13 @@ PP(pp_fileno) dSP; dTARGET; GV *gv; IO *io; - FILE *fp; + PerlIO *fp; if (MAXARG < 1) RETPUSHUNDEF; gv = (GV*)POPs; if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) RETPUSHUNDEF; - PUSHi(fileno(fp)); + PUSHi(PerlIO_fileno(fp)); RETURN; } @@ -364,7 +357,7 @@ PP(pp_binmode) dSP; GV *gv; IO *io; - FILE *fp; + PerlIO *fp; if (MAXARG < 1) RETPUSHUNDEF; @@ -377,19 +370,27 @@ PP(pp_binmode) #ifdef DOSISH #ifdef atarist - if (!fflush(fp) && (fp->_flag |= _IOBIN)) + if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN)) RETPUSHYES; else RETPUSHUNDEF; #else - if (setmode(fileno(fp), OP_BINARY) != -1) + if (setmode(PerlIO_fileno(fp), OP_BINARY) != -1) RETPUSHYES; else RETPUSHUNDEF; #endif #else +#if defined(USEMYBINMODE) + if (my_binmode(fp,IoTYPE(io)) != NULL) + RETPUSHYES; + else + RETPUSHUNDEF; +#else RETPUSHYES; #endif +#endif + } PP(pp_tie) @@ -427,12 +428,14 @@ PP(pp_tie) ENTER; SAVESPTR(op); op = (OP *) &myop; + if (perldb && curstash != debstash) + op->op_private |= OPpENTERSUB_DB; - XPUSHs(gv); + XPUSHs((SV*)gv); PUTBACK; if (op = pp_entersub()) - run(); + runops(); SPAGAIN; sv = TOPs; @@ -455,13 +458,53 @@ PP(pp_tie) PP(pp_untie) { dSP; - if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV) - sv_unmagic(TOPs, 'P'); + SV * sv ; + + sv = POPs; + if (hints & HINT_STRICT_UNTIE) + { + MAGIC * mg ; + if (SvMAGICAL(sv)) { + if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + mg = mg_find(sv, 'P') ; + else + mg = mg_find(sv, 'q') ; + + if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1) + croak("Can't untie: %d inner references still exist", + SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ; + } + } + + if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + sv_unmagic(sv, 'P'); else - sv_unmagic(TOPs, 'q'); + sv_unmagic(sv, 'q'); RETSETYES; } +PP(pp_tied) +{ + dSP; + SV * sv ; + MAGIC * mg ; + + sv = POPs; + if (SvMAGICAL(sv)) { + if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + mg = mg_find(sv, 'P') ; + else + mg = mg_find(sv, 'q') ; + + if (mg) { + PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ; + RETURN ; + } + } + + RETPUSHUNDEF; +} + PP(pp_dbmopen) { dSP; @@ -493,6 +536,8 @@ PP(pp_dbmopen) ENTER; SAVESPTR(op); op = (OP *) &myop; + if (perldb && curstash != debstash) + op->op_private |= OPpENTERSUB_DB; PUTBACK; pp_pushmark(); @@ -504,11 +549,11 @@ PP(pp_dbmopen) else PUSHs(sv_2mortal(newSViv(O_RDWR))); PUSHs(right); - PUSHs(gv); + PUSHs((SV*)gv); PUTBACK; if (op = pp_entersub()) - run(); + runops(); SPAGAIN; if (!sv_isobject(TOPs)) { @@ -521,11 +566,11 @@ PP(pp_dbmopen) PUSHs(left); PUSHs(sv_2mortal(newSViv(O_RDONLY))); PUSHs(right); - PUSHs(gv); + PUSHs((SV*)gv); PUTBACK; if (op = pp_entersub()) - run(); + runops(); SPAGAIN; } @@ -621,11 +666,13 @@ PP(pp_sselect) j = SvLEN(sv); if (j < growsize) { Sv_Grow(sv, growsize); - s = SvPVX(sv) + j; - while (++j <= growsize) { - *s++ = '\0'; - } } + j = SvCUR(sv); + s = SvPVX(sv) + j; + while (++j <= growsize) { + *s++ = '\0'; + } + #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 s = SvPVX(sv); New(403, fd_sets[i], growsize, char); @@ -698,11 +745,11 @@ PP(pp_select) if (! hv) XPUSHs(&sv_undef); else { - GV **gvp = hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE); + GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE); if (gvp && *gvp == egv) gv_efullname(TARG, defoutgv); else - sv_setsv(TARG, sv_2mortal(newRV(egv))); + sv_setsv(TARG, sv_2mortal(newRV((SV*)egv))); XPUSHTARG; } @@ -730,7 +777,7 @@ PP(pp_getc) RETPUSHUNDEF; TAINT_IF(1); sv_setpv(TARG, " "); - *SvPVX(TARG) = getc(IoIFP(GvIOp(gv))); /* should never be EOF */ + *SvPVX(TARG) = PerlIO_getc(IoIFP(GvIOp(gv))); /* should never be EOF */ PUSHTARG; RETURN; } @@ -809,13 +856,13 @@ PP(pp_leavewrite) dSP; GV *gv = cxstack[cxstack_ix].blk_sub.gv; register IO *io = GvIOp(gv); - FILE *ofp = IoOFP(io); - FILE *fp; + PerlIO *ofp = IoOFP(io); + PerlIO *fp; SV **newsp; I32 gimme; register CONTEXT *cx; - DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n", + DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n", (long)IoLINES_LEFT(io), (long)FmLINES(formtarget))); if (IoLINES_LEFT(io) < FmLINES(formtarget) && formtarget != toptarget) @@ -856,13 +903,13 @@ PP(pp_leavewrite) s++; } if (s) { - fwrite1(SvPVX(formtarget), s - SvPVX(formtarget), 1, ofp); + PerlIO_write(ofp, SvPVX(formtarget), s - SvPVX(formtarget)); sv_chop(formtarget, s); FmLINES(formtarget) -= IoLINES_LEFT(io); } } if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0) - fwrite1(SvPVX(formfeed), SvCUR(formfeed), 1, ofp); + PerlIO_write(ofp, SvPVX(formfeed), SvCUR(formfeed)); IoLINES_LEFT(io) = IoPAGE_LEN(io); IoPAGE(io)++; formtarget = toptarget; @@ -899,15 +946,15 @@ PP(pp_leavewrite) if (dowarn) warn("page overflow"); } - if (!fwrite1(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) || - ferror(fp)) + if (!PerlIO_write(ofp, SvPVX(formtarget), SvCUR(formtarget)) || + PerlIO_error(fp)) PUSHs(&sv_no); else { FmLINES(formtarget) = 0; SvCUR_set(formtarget, 0); *SvEND(formtarget) = '\0'; if (IoFLAGS(io) & IOf_FLUSH) - (void)fflush(fp); + (void)PerlIO_flush(fp); PUSHs(&sv_yes); } } @@ -921,7 +968,7 @@ PP(pp_prtf) dSP; dMARK; dORIGMARK; GV *gv; IO *io; - FILE *fp; + PerlIO *fp; SV *sv = NEWSV(0,0); if (op->op_flags & OPf_STACKED) @@ -953,7 +1000,7 @@ PP(pp_prtf) goto just_say_no; if (IoFLAGS(io) & IOf_FLUSH) - if (fflush(fp) == EOF) + if (PerlIO_flush(fp) == EOF) goto just_say_no; } SvREFCNT_dec(sv); @@ -968,6 +1015,34 @@ PP(pp_prtf) RETURN; } +PP(pp_sysopen) +{ + dSP; + GV *gv; + SV *sv; + char *tmps; + STRLEN len; + int mode, perm; + + if (MAXARG > 3) + perm = POPi; + else + perm = 0666; + mode = POPi; + sv = POPs; + gv = (GV *)POPs; + + tmps = SvPV(sv, len); + if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) { + IoLINES(GvIOp(gv)) = 0; + PUSHs(&sv_yes); + } + else { + PUSHs(&sv_undef); + } + RETURN; +} + PP(pp_sysread) { dSP; dMARK; dORIGMARK; dTARGET; @@ -1000,7 +1075,7 @@ PP(pp_sysread) if (op->op_type == OP_RECV) { bufsize = sizeof buf; buffer = SvGROW(bufsv, length+1); - length = recvfrom(fileno(IoIFP(io)), buffer, length, offset, + length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, (struct sockaddr *)buf, &bufsize); if (length < 0) RETPUSHUNDEF; @@ -1021,18 +1096,18 @@ PP(pp_sysread) #endif buffer = SvGROW(bufsv, length+offset+1); if (op->op_type == OP_SYSREAD) { - length = read(fileno(IoIFP(io)), buffer+offset, length); + length = read(PerlIO_fileno(IoIFP(io)), buffer+offset, length); } else #ifdef HAS_SOCKET__bad_code_maybe if (IoTYPE(io) == 's') { bufsize = sizeof buf; - length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0, + length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0, (struct sockaddr *)buf, &bufsize); } else #endif - length = fread(buffer+offset, 1, length, IoIFP(io)); + length = PerlIO_read(IoIFP(io), buffer+offset, length); if (length < 0) goto say_undef; SvCUR_set(bufsv, length+offset); @@ -1092,18 +1167,18 @@ PP(pp_send) offset = 0; if (length > blen - offset) length = blen - offset; - length = write(fileno(IoIFP(io)), buffer+offset, length); + length = write(PerlIO_fileno(IoIFP(io)), buffer+offset, length); } #ifdef HAS_SOCKET else if (SP > MARK) { char *sockbuf; STRLEN mlen; sockbuf = SvPVx(*++MARK, mlen); - length = sendto(fileno(IoIFP(io)), buffer, blen, length, + length = sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length, (struct sockaddr *)sockbuf, mlen); } else - length = send(fileno(IoIFP(io)), buffer, blen, length); + length = send(PerlIO_fileno(IoIFP(io)), buffer, blen, length); #else else DIE(no_sock_func, "send"); @@ -1171,34 +1246,44 @@ PP(pp_truncate) SETERRNO(0,0); #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP) -#ifdef HAS_TRUNCATE - if (op->op_flags & OPf_SPECIAL) { - tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO); - if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) || - ftruncate(fileno(IoIFP(GvIOn(tmpgv))), len) < 0) - result = 0; - } - else if (truncate(POPp, len) < 0) - result = 0; -#else if (op->op_flags & OPf_SPECIAL) { tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO); + do_ftruncate: if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) || - chsize(fileno(IoIFP(GvIOn(tmpgv))), len) < 0) +#ifdef HAS_TRUNCATE + ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0) +#else + my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0) +#endif result = 0; } else { - int tmpfd; - - if ((tmpfd = open(POPp, 0)) < 0) + SV *sv = POPs; + if (SvTYPE(sv) == SVt_PVGV) { + tmpgv = (GV*)sv; /* *main::FRED for example */ + goto do_ftruncate; + } + else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { + tmpgv = (GV*) SvRV(sv); /* \*main::FRED for example */ + goto do_ftruncate; + } +#ifdef HAS_TRUNCATE + if (truncate (SvPV (sv, na), len) < 0) result = 0; - else { - if (chsize(tmpfd, len) < 0) - result = 0; - close(tmpfd); +#else + { + int tmpfd; + + if ((tmpfd = open(SvPV (sv, na), 0)) < 0) + result = 0; + else { + if (my_chsize(tmpfd, len) < 0) + result = 0; + close(tmpfd); + } } - } #endif + } if (result) RETPUSHYES; @@ -1255,7 +1340,7 @@ PP(pp_ioctl) if (optype == OP_IOCTL) #ifdef HAS_IOCTL - retval = ioctl(fileno(IoIFP(io)), func, s); + retval = ioctl(PerlIO_fileno(IoIFP(io)), func, s); #else DIE("ioctl is not implemented"); #endif @@ -1265,9 +1350,9 @@ PP(pp_ioctl) #else # ifdef HAS_FCNTL # if defined(OS2) && defined(__EMX__) - retval = fcntl(fileno(IoIFP(io)), func, (int)s); + retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s); # else - retval = fcntl(fileno(IoIFP(io)), func, s); + retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s); # endif # else DIE("fcntl is not implemented"); @@ -1299,7 +1384,7 @@ PP(pp_flock) I32 value; int argtype; GV *gv; - FILE *fp; + PerlIO *fp; #if !defined(HAS_FLOCK) && defined(HAS_LOCKF) # define flock lockf_emulate_flock @@ -1316,7 +1401,7 @@ PP(pp_flock) else fp = Nullfp; if (fp) { - value = (I32)(flock(fileno(fp), argtype) >= 0); + value = (I32)(flock(PerlIO_fileno(fp), argtype) >= 0); } else value = 0; @@ -1355,12 +1440,12 @@ PP(pp_socket) fd = socket(domain, type, protocol); if (fd < 0) RETPUSHUNDEF; - IoIFP(io) = fdopen(fd, "r"); /* stdio gets confused about sockets */ - IoOFP(io) = fdopen(fd, "w"); + IoIFP(io) = PerlIO_fdopen(fd, "r"); /* stdio gets confused about sockets */ + IoOFP(io) = PerlIO_fdopen(fd, "w"); IoTYPE(io) = 's'; if (!IoIFP(io) || !IoOFP(io)) { - if (IoIFP(io)) fclose(IoIFP(io)); - if (IoOFP(io)) fclose(IoOFP(io)); + if (IoIFP(io)) PerlIO_close(IoIFP(io)); + if (IoOFP(io)) PerlIO_close(IoOFP(io)); if (!IoIFP(io) && !IoOFP(io)) close(fd); RETPUSHUNDEF; } @@ -1399,18 +1484,18 @@ PP(pp_sockpair) TAINT_PROPER("socketpair"); if (socketpair(domain, type, protocol, fd) < 0) RETPUSHUNDEF; - IoIFP(io1) = fdopen(fd[0], "r"); - IoOFP(io1) = fdopen(fd[0], "w"); + IoIFP(io1) = PerlIO_fdopen(fd[0], "r"); + IoOFP(io1) = PerlIO_fdopen(fd[0], "w"); IoTYPE(io1) = 's'; - IoIFP(io2) = fdopen(fd[1], "r"); - IoOFP(io2) = fdopen(fd[1], "w"); + IoIFP(io2) = PerlIO_fdopen(fd[1], "r"); + IoOFP(io2) = PerlIO_fdopen(fd[1], "w"); IoTYPE(io2) = 's'; if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) { - if (IoIFP(io1)) fclose(IoIFP(io1)); - if (IoOFP(io1)) fclose(IoOFP(io1)); + if (IoIFP(io1)) PerlIO_close(IoIFP(io1)); + if (IoOFP(io1)) PerlIO_close(IoOFP(io1)); if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]); - if (IoIFP(io2)) fclose(IoIFP(io2)); - if (IoOFP(io2)) fclose(IoOFP(io2)); + if (IoIFP(io2)) PerlIO_close(IoIFP(io2)); + if (IoOFP(io2)) PerlIO_close(IoOFP(io2)); if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]); RETPUSHUNDEF; } @@ -1436,7 +1521,7 @@ PP(pp_bind) addr = SvPV(addrsv, len); TAINT_PROPER("bind"); - if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0) + if (bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0) RETPUSHYES; else RETPUSHUNDEF; @@ -1466,7 +1551,7 @@ PP(pp_connect) addr = SvPV(addrsv, len); TAINT_PROPER("connect"); - if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0) + if (connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0) RETPUSHYES; else RETPUSHUNDEF; @@ -1492,7 +1577,7 @@ PP(pp_listen) if (!io || !IoIFP(io)) goto nuts; - if (listen(fileno(IoIFP(io)), backlog) >= 0) + if (listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0) RETPUSHYES; else RETPUSHUNDEF; @@ -1535,15 +1620,15 @@ PP(pp_accept) if (IoIFP(nstio)) do_close(ngv, FALSE); - fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len); + fd = accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len); if (fd < 0) goto badexit; - IoIFP(nstio) = fdopen(fd, "r"); - IoOFP(nstio) = fdopen(fd, "w"); + IoIFP(nstio) = PerlIO_fdopen(fd, "r"); + IoOFP(nstio) = PerlIO_fdopen(fd, "w"); IoTYPE(nstio) = 's'; if (!IoIFP(nstio) || !IoOFP(nstio)) { - if (IoIFP(nstio)) fclose(IoIFP(nstio)); - if (IoOFP(nstio)) fclose(IoOFP(nstio)); + if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio)); + if (IoOFP(nstio)) PerlIO_close(IoOFP(nstio)); if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd); goto badexit; } @@ -1575,7 +1660,7 @@ PP(pp_shutdown) if (!io || !IoIFP(io)) goto nuts; - PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 ); + PUSHi( shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 ); RETURN; nuts: @@ -1622,7 +1707,7 @@ PP(pp_ssockopt) if (!io || !IoIFP(io)) goto nuts; - fd = fileno(IoIFP(io)); + fd = PerlIO_fileno(IoIFP(io)); switch (optype) { case OP_GSOCKOPT: SvGROW(sv, 257); @@ -1694,7 +1779,7 @@ PP(pp_getpeername) SvCUR_set(sv,256); *SvEND(sv) ='\0'; aint = SvCUR(sv); - fd = fileno(IoIFP(io)); + fd = PerlIO_fileno(IoIFP(io)); switch (optype) { case OP_GETSOCKNAME: if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0) @@ -1743,7 +1828,7 @@ PP(pp_stat) statgv = tmpgv; sv_setpv(statname, ""); if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) || - Fstat(fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) { + Fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) { max = 0; laststatval = -1; } @@ -1791,11 +1876,21 @@ PP(pp_stat) PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid))); +#ifdef USE_STAT_RDEV PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev))); +#else + PUSHs(sv_2mortal(newSVpv("", 0))); +#endif PUSHs(sv_2mortal(newSViv((I32)statcache.st_size))); +#ifdef BIG_TIME + PUSHs(sv_2mortal(newSVnv((U32)statcache.st_atime))); + PUSHs(sv_2mortal(newSVnv((U32)statcache.st_mtime))); + PUSHs(sv_2mortal(newSVnv((U32)statcache.st_ctime))); +#else PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime))); +#endif #ifdef USE_STAT_BLOCKS PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks))); @@ -1925,7 +2020,7 @@ PP(pp_ftmtime) dSP; dTARGET; if (result < 0) RETPUSHUNDEF; - PUSHn( (basetime - statcache.st_mtime) / 86400.0 ); + PUSHn( ((I32)basetime - (I32)statcache.st_mtime) / 86400.0 ); RETURN; } @@ -1935,7 +2030,7 @@ PP(pp_ftatime) dSP; dTARGET; if (result < 0) RETPUSHUNDEF; - PUSHn( (basetime - statcache.st_atime) / 86400.0 ); + PUSHn( ((I32)basetime - (I32)statcache.st_atime) / 86400.0 ); RETURN; } @@ -1945,7 +2040,7 @@ PP(pp_ftctime) dSP; dTARGET; if (result < 0) RETPUSHUNDEF; - PUSHn( (basetime - statcache.st_ctime) / 86400.0 ); + PUSHn( ((I32)basetime - (I32)statcache.st_ctime) / 86400.0 ); RETURN; } @@ -2081,7 +2176,7 @@ PP(pp_fttty) else gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO); if (GvIO(gv) && IoIFP(GvIOp(gv))) - fd = fileno(IoIFP(GvIOp(gv))); + fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (isDIGIT(*tmps)) fd = atoi(tmps); else @@ -2126,25 +2221,29 @@ PP(pp_fttext) io = GvIO(statgv); } if (io && IoIFP(io)) { -#ifdef FILE_base - Fstat(fileno(IoIFP(io)), &statcache); + if (PerlIO_has_base(IoIFP(io))) { + Fstat(PerlIO_fileno(IoIFP(io)), &statcache); if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */ if (op->op_type == OP_FTTEXT) RETPUSHNO; else RETPUSHYES; - if (FILE_cnt(IoIFP(io)) <= 0) { - i = getc(IoIFP(io)); + if (PerlIO_get_cnt(IoIFP(io)) <= 0) { + i = PerlIO_getc(IoIFP(io)); if (i != EOF) - (void)ungetc(i, IoIFP(io)); + (void)PerlIO_ungetc(IoIFP(io),i); } - if (FILE_cnt(IoIFP(io)) <= 0) /* null file is anything */ + if (PerlIO_get_cnt(IoIFP(io)) <= 0) /* null file is anything */ RETPUSHYES; - len = FILE_bufsiz(IoIFP(io)); - s = FILE_base(IoIFP(io)); -#else + len = PerlIO_get_bufsiz(IoIFP(io)); + s = (STDCHAR *) PerlIO_get_base(IoIFP(io)); + /* sfio can have large buffers - limit to 512 */ + if (len > 512) + len = 512; + } + else { DIE("-T and -B not implemented on filehandles"); -#endif + } } else { if (dowarn) @@ -2378,7 +2477,7 @@ char *filename; char *s, *save_filename = filename; int anum = 1; - FILE *myfp; + PerlIO *myfp; strcpy(mybuf, cmd); strcat(mybuf, " "); @@ -2390,7 +2489,8 @@ char *filename; myfp = my_popen(mybuf, "r"); if (myfp) { *mybuf = '\0'; - s = fgets(mybuf, sizeof mybuf, myfp); + /* Need to save/restore 'rs' ?? */ + s = sv_gets(tmpsv, myfp, 0); (void)my_pclose(myfp); if (s != Nullch) { for (errno = 1; errno < sys_nerr; errno++) { @@ -2730,7 +2830,7 @@ PP(pp_system) Signal_t (*ihand)(); /* place to save signal during system() */ Signal_t (*qhand)(); /* place to save signal during system() */ -#if defined(HAS_FORK) && !defined(VMS) +#if defined(HAS_FORK) && !defined(VMS) && !defined(OS2) if (SP - MARK == 1) { if (tainting) { char *junk = SvPV(TOPs, na); @@ -2776,7 +2876,7 @@ PP(pp_system) value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na)); } _exit(-1); -#else /* ! FORK or VMS */ +#else /* ! FORK or VMS or OS/2 */ if (op->op_flags & OPf_STACKED) { SV *really = *++MARK; value = (I32)do_aspawn(really, MARK, SP); @@ -2862,8 +2962,8 @@ PP(pp_getpgrp) pid = 0; else pid = SvIVx(POPs); -#ifdef USE_BSDPGRP - value = (I32)getpgrp(pid); +#ifdef BSD_GETPGRP + value = (I32)BSD_GETPGRP(pid); #else if (pid != 0) DIE("POSIX getpgrp can't take an argument"); @@ -2892,8 +2992,8 @@ PP(pp_setpgrp) } TAINT_PROPER("setpgrp"); -#ifdef USE_BSDPGRP - SETi( setpgrp(pid, pgrp) >= 0 ); +#ifdef BSD_SETPGRP + SETi( BSD_SETPGRP(pid, pgrp) >= 0 ); #else if ((pgrp != 0) || (pid != 0)) { DIE("POSIX setpgrp can't take an argument"); @@ -2944,7 +3044,11 @@ PP(pp_setpriority) PP(pp_time) { dSP; dTARGET; +#ifdef BIG_TIME + XPUSHn( time(Null(Time_t*)) ); +#else XPUSHi( time(Null(Time_t*)) ); +#endif RETURN; } @@ -2998,7 +3102,11 @@ PP(pp_gmtime) if (MAXARG < 1) (void)time(&when); else +#ifdef BIG_TIME + when = (Time_t)SvNVx(POPs); +#else when = (Time_t)SvIVx(POPs); +#endif if (op->op_type == OP_LOCALTIME) tmbuf = localtime(&when);