This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
More explicit Solaris instructions
[perl5.git] / pp_sys.c
index 4eca776..ef769a5 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -154,6 +154,16 @@ static int dooneliner _((char *cmd, char *filename));
 
 #endif /* no flock() */
 
+#ifndef MAXPATHLEN
+#  ifdef PATH_MAX
+#    define MAXPATHLEN PATH_MAX
+#  else
+#    define MAXPATHLEN 1024
+#  endif
+#endif
+
+#define ZBTLEN 10
+static char zero_but_true[ZBTLEN + 1] = "0 but true";
 
 /* Pushy I/O. */
 
@@ -168,7 +178,7 @@ PP(pp_backtick)
     fp = my_popen(tmps, "r");
     if (fp) {
        if (gimme == G_VOID) {
-           while (PerlIO_read(fp, buf, sizeof buf) > 0)
+           while (PerlIO_read(fp, tokenbuf, sizeof tokenbuf) > 0)
                /*SUPPRESS 530*/
                ;
        }
@@ -968,16 +978,16 @@ PP(pp_leavewrite)
        CV *cv;
        if (!IoTOP_GV(io)) {
            GV *topgv;
-           char tmpbuf[256];
+           SV *topname;
 
            if (!IoTOP_NAME(io)) {
                if (!IoFMT_NAME(io))
                    IoFMT_NAME(io) = savepv(GvNAME(gv));
-               sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
-               topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
+               topname = sv_2mortal(newSVpvf("%s_TOP", IoFMT_NAME(io)));
+               topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
                  !gv_fetchpv("top",FALSE,SVt_PVFM))
-                   IoTOP_NAME(io) = savepv(tmpbuf);
+                   IoTOP_NAME(io) = savepv(SvPVX(topname));
                else
                    IoTOP_NAME(io) = savepv("top");
            }
@@ -1068,12 +1078,35 @@ PP(pp_prtf)
     GV *gv;
     IO *io;
     PerlIO *fp;
-    SV *sv = NEWSV(0,0);
+    SV *sv;
+    MAGIC *mg;
 
     if (op->op_flags & OPf_STACKED)
        gv = (GV*)*++MARK;
     else
        gv = defoutgv;
+
+    if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+       if (MARK == ORIGMARK) {
+           EXTEND(SP, 1);
+           ++MARK;
+           Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
+           ++SP;
+       }
+       PUSHMARK(MARK - 1);
+       *MARK = mg->mg_obj;
+       PUTBACK;
+       ENTER;
+       perl_call_method("PRINTF", G_SCALAR);
+       LEAVE;
+       SPAGAIN;
+       MARK = ORIGMARK + 1;
+       *MARK = *SP;
+       SP = MARK;
+       RETURN;
+    }
+
+    sv = NEWSV(0,0);
     if (!(io = GvIO(gv))) {
        if (dowarn) {
            gv_fullname3(sv, gv, Nullch);
@@ -1162,7 +1195,7 @@ PP(pp_sysread)
     MAGIC *mg;
 
     gv = (GV*)*++MARK;
-    if (op->op_type == OP_READ &&
+    if ((op->op_type == OP_READ || op->op_type == OP_SYSREAD) &&
        SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
     {
        SV *sv;
@@ -1198,11 +1231,12 @@ PP(pp_sysread)
        goto say_undef;
 #ifdef HAS_SOCKET
     if (op->op_type == OP_RECV) {
-       bufsize = sizeof buf;
+       char namebuf[MAXPATHLEN];
+       bufsize = sizeof namebuf;
        buffer = SvGROW(bufsv, length+1);
        /* 'offset' means 'flags' here */
        length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
-           (struct sockaddr *)buf, &bufsize);
+                         (struct sockaddr *)namebuf, &bufsize);
        if (length < 0)
            RETPUSHUNDEF;
        SvCUR_set(bufsv, length);
@@ -1213,7 +1247,7 @@ PP(pp_sysread)
        if (!(IoFLAGS(io) & IOf_UNTAINT))
            SvTAINTED_on(bufsv);
        SP = ORIGMARK;
-       sv_setpvn(TARG, buf, bufsize);
+       sv_setpvn(TARG, namebuf, bufsize);
        PUSHs(TARG);
        RETURN;
     }
@@ -1237,9 +1271,10 @@ PP(pp_sysread)
     else
 #ifdef HAS_SOCKET__bad_code_maybe
     if (IoTYPE(io) == 's') {
-       bufsize = sizeof buf;
+       char namebuf[MAXPATHLEN];
+       bufsize = sizeof namebuf;
        length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0,
-           (struct sockaddr *)buf, &bufsize);
+                         (struct sockaddr *)namebuf, &bufsize);
     }
     else
 #endif
@@ -1381,7 +1416,14 @@ PP(pp_sysseek)
     long offset = POPl;
 
     gv = last_in_gv = (GV*)POPs;
-    PUSHs(boolSV(do_seek(gv, offset, whence)));
+    if (op->op_type == OP_SEEK)
+       PUSHs(boolSV(do_seek(gv, offset, whence)));
+    else {
+       long n = do_sysseek(gv, offset, whence);
+       PUSHs((n < 0) ? &sv_undef
+             : sv_2mortal(n ? newSViv((IV)n)
+                          : newSVpv(zero_but_true, ZBTLEN)));
+    }
     RETURN;
 }
 
@@ -1460,7 +1502,7 @@ PP(pp_ioctl)
     unsigned int func = U_I(POPn);
     int optype = op->op_type;
     char *s;
-    int retval;
+    IV retval;
     GV *gv = (GV*)POPs;
     IO *io = GvIOn(gv);
 
@@ -1471,22 +1513,19 @@ PP(pp_ioctl)
 
     if (SvPOK(argsv) || !SvNIOK(argsv)) {
        STRLEN len;
+       STRLEN need;
        s = SvPV_force(argsv, len);
-       retval = IOCPARM_LEN(func);
-       if (len < retval) {
-           s = Sv_Grow(argsv, retval+1);
-           SvCUR_set(argsv, retval);
+       need = IOCPARM_LEN(func);
+       if (len < need) {
+           s = Sv_Grow(argsv, need + 1);
+           SvCUR_set(argsv, need);
        }
 
        s[SvCUR(argsv)] = 17;   /* a little sanity check here */
     }
     else {
        retval = SvIV(argsv);
-#ifdef DOSISH
-       s = (char*)(long)retval;        /* ouch */
-#else
        s = (char*)retval;              /* ouch */
-#endif
     }
 
     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
@@ -1522,7 +1561,7 @@ PP(pp_ioctl)
        PUSHi(retval);
     }
     else {
-       PUSHp("0 but true", 10);
+       PUSHp(zero_but_true, ZBTLEN);
     }
     RETURN;
 }
@@ -2621,7 +2660,9 @@ PP(pp_readlink)
     dSP; dTARGET;
 #ifdef HAS_SYMLINK
     char *tmps;
+    char buf[MAXPATHLEN];
     int len;
+
     tmps = POPp;
     len = readlink(tmps, buf, sizeof buf);
     EXTEND(SP, 1);
@@ -3294,18 +3335,18 @@ PP(pp_gmtime)
     EXTEND_MORTAL(9);
     if (GIMME != G_ARRAY) {
        dTARGET;
-       char mybuf[30];
+       SV *tsv;
        if (!tmbuf)
            RETPUSHUNDEF;
-       sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
-           dayname[tmbuf->tm_wday],
-           monname[tmbuf->tm_mon],
-           tmbuf->tm_mday,
-           tmbuf->tm_hour,
-           tmbuf->tm_min,
-           tmbuf->tm_sec,
-           tmbuf->tm_year + 1900);
-       PUSHp(mybuf, strlen(mybuf));
+       tsv = newSVpvf("%s %s %2d %02d:%02d:%02d %d",
+                      dayname[tmbuf->tm_wday],
+                      monname[tmbuf->tm_mon],
+                      tmbuf->tm_mday,
+                      tmbuf->tm_hour,
+                      tmbuf->tm_min,
+                      tmbuf->tm_sec,
+                      tmbuf->tm_year + 1900);
+       PUSHs(sv_2mortal(tsv));
     }
     else if (tmbuf) {
        PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
@@ -3454,7 +3495,7 @@ PP(pp_semctl)
        PUSHi(anum);
     }
     else {
-       PUSHp("0 but true",10);
+       PUSHp(zero_but_true, ZBTLEN);
     }
     RETURN;
 #else