Add explanation of common usage
[p5sagit/p5-mst-13.2.git] / pp_sys.c
index 8a6c17a..ba1f105 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -86,14 +86,6 @@ extern int h_errno;
 #include <sys/file.h>
 #endif
 
-#ifdef HAS_GETPGRP2
-#   define getpgrp getpgrp2
-#endif
-
-#ifdef HAS_SETPGRP2
-#   define setpgrp setpgrp2
-#endif
-
 #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
 static int dooneliner _((char *cmd, char *filename));
 #endif
@@ -130,7 +122,7 @@ PP(pp_backtick)
                }
            }
        }
-       statusvalue = my_pclose(fp);
+       statusvalue = FIXSTATUS(my_pclose(fp));
     }
     else {
        statusvalue = -1;
@@ -145,22 +137,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;
@@ -192,7 +180,7 @@ PP(pp_warn)
        tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-       SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
+       SV *error = GvSV(errgv);
        (void)SvUPGRADE(error, SVt_PV);
        if (SvPOK(error) && SvCUR(error))
            sv_catpv(error, "\t...caught");
@@ -218,7 +206,7 @@ PP(pp_die)
        tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-       SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
+       SV *error = GvSV(errgv);
        (void)SvUPGRADE(error, SVt_PV);
        if (SvPOK(error) && SvCUR(error))
            sv_catpv(error, "\t...propagated");
@@ -241,11 +229,13 @@ PP(pp_open)
 
     if (MAXARG > 1)
        sv = POPs;
-    else
+    else if (SvTYPE(TOPs) == SVt_PVGV)
        sv = GvSV(TOPs);
+    else
+       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 );
     }
@@ -286,6 +276,8 @@ PP(pp_pipe_op)
     if (!rgv || !wgv)
        goto badexit;
 
+    if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
+       DIE(no_usym, "filehandle");
     rstio = GvIOn(rgv);
     wstio = GvIOn(wgv);
 
@@ -373,7 +365,7 @@ PP(pp_binmode)
 
 #ifdef DOSISH
 #ifdef atarist
-    if (!fflush(fp) && (fp->_flag |= _IOBIN))
+    if (!Fflush(fp) && (fp->_flag |= _IOBIN))
        RETPUSHYES;
     else
        RETPUSHUNDEF;
@@ -428,7 +420,7 @@ PP(pp_tie)
     PUTBACK;
 
     if (op = pp_entersub())
-        run();
+        runops();
     SPAGAIN;
 
     sv = TOPs;
@@ -458,6 +450,28 @@ PP(pp_untie)
     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;
@@ -475,7 +489,7 @@ PP(pp_dbmopen)
     stash = gv_stashsv(sv, FALSE);
     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
        PUTBACK;
-       perl_requirepv("AnyDBM_File.pm");
+       perl_require_pv("AnyDBM_File.pm");
        SPAGAIN;
        if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
            DIE("No dbm on this machine");
@@ -504,7 +518,7 @@ PP(pp_dbmopen)
     PUTBACK;
 
     if (op = pp_entersub())
-        run();
+        runops();
     SPAGAIN;
 
     if (!sv_isobject(TOPs)) {
@@ -521,7 +535,7 @@ PP(pp_dbmopen)
        PUTBACK;
 
        if (op = pp_entersub())
-           run();
+           runops();
        SPAGAIN;
     }
 
@@ -574,7 +588,11 @@ PP(pp_sselect)
     }
 
 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+#ifdef __linux__
+    growsize = sizeof(fd_set);
+#else
     growsize = maxlen;         /* little endians can use vecs directly */
+#endif
 #else
 #ifdef NFDBITS
 
@@ -613,11 +631,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);
@@ -664,17 +684,46 @@ PP(pp_sselect)
 #endif
 }
 
+void
+setdefout(gv)
+GV *gv;
+{
+    if (gv)
+       (void)SvREFCNT_inc(gv);
+    if (defoutgv)
+       SvREFCNT_dec(defoutgv);
+    defoutgv = gv;
+}
+
 PP(pp_select)
 {
     dSP; dTARGET;
-    GV *oldgv = defoutgv;
-    if (op->op_private > 0) {
-       defoutgv = (GV*)POPs;
-       if (!GvIO(defoutgv))
-           gv_IOadd(defoutgv);
+    GV *newdefout, *egv;
+    HV *hv;
+
+    newdefout = (op->op_private > 0) ? ((GV *) POPs) : NULL;
+
+    egv = GvEGV(defoutgv);
+    if (!egv)
+       egv = defoutgv;
+    hv = GvSTASH(egv);
+    if (! hv)
+       XPUSHs(&sv_undef);
+    else {
+       GV **gvp = hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
+       if (gvp && *gvp == egv)
+           gv_efullname(TARG, defoutgv);
+       else
+           sv_setsv(TARG, sv_2mortal(newRV(egv)));
+       XPUSHTARG;
+    }
+
+    if (newdefout) {
+       if (!GvIO(newdefout))
+           gv_IOadd(newdefout);
+       setdefout(newdefout);
     }
-    gv_efullname(TARG, oldgv);
-    XPUSHTARG;
+
     RETURN;
 }
 
@@ -723,7 +772,7 @@ OP *retop;
     SAVESPTR(curpad);
     curpad = AvARRAY((AV*)svp[1]);
 
-    defoutgv = gv;             /* locally select filehandle so $% et al work */
+    setdefout(gv);         /* locally select filehandle so $% et al work */
     return CvSTART(cv);
 }
 
@@ -783,6 +832,8 @@ PP(pp_leavewrite)
     if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
        formtarget != toptarget)
     {
+       GV *fgv;
+       CV *cv;
        if (!IoTOP_GV(io)) {
            GV *topgv;
            char tmpbuf[256];
@@ -808,6 +859,8 @@ PP(pp_leavewrite)
        if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear.  It still doesn't fit. */
            I32 lines = IoLINES_LEFT(io);
            char *s = SvPVX(formtarget);
+           if (lines <= 0)             /* Yow, header didn't even fit!!! */
+               goto forget_top;
            while (lines-- > 0) {
                s = strchr(s, '\n');
                if (!s)
@@ -826,7 +879,16 @@ PP(pp_leavewrite)
        IoPAGE(io)++;
        formtarget = toptarget;
        IoFLAGS(io) |= IOf_DIDTOP;
-       return doform(GvFORM(IoTOP_GV(io)),gv,op);
+       fgv = IoTOP_GV(io);
+       if (!fgv)
+           DIE("bad top format reference");
+       cv = GvFORM(fgv);
+       if (!cv) {
+           SV *tmpsv = sv_newmortal();
+           gv_efullname(tmpsv, fgv);
+           DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
+       }
+       return doform(cv,gv,op);
     }
 
   forget_top:
@@ -857,7 +919,7 @@ PP(pp_leavewrite)
            SvCUR_set(formtarget, 0);
            *SvEND(formtarget) = '\0';
            if (IoFLAGS(io) & IOf_FLUSH)
-               (void)fflush(fp);
+               (void)Fflush(fp);
            PUSHs(&sv_yes);
        }
     }
@@ -903,7 +965,7 @@ PP(pp_prtf)
            goto just_say_no;
 
        if (IoFLAGS(io) & IOf_FLUSH)
-           if (fflush(fp) == EOF)
+           if (Fflush(fp) == EOF)
                goto just_say_no;
     }
     SvREFCNT_dec(sv);
@@ -918,6 +980,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;
@@ -1210,11 +1300,15 @@ PP(pp_ioctl)
        DIE("ioctl is not implemented");
 #endif
     else
-#ifdef DOSISH
+#if defined(DOSISH) && !defined(OS2)
        DIE("fcntl is not implemented");
 #else
 #   ifdef HAS_FCNTL
+#     if defined(OS2) && defined(__EMX__)
+       retval = fcntl(fileno(IoIFP(io)), func, (int)s);
+#     else
        retval = fcntl(fileno(IoIFP(io)), func, s);
+#     endif 
 #   else
        DIE("fcntl is not implemented");
 #   endif
@@ -1455,13 +1549,13 @@ nuts:
 
 PP(pp_accept)
 {
-    struct sockaddr_in saddr;  /* use a struct to avoid alignment problems */
     dSP; dTARGET;
 #ifdef HAS_SOCKET
     GV *ngv;
     GV *ggv;
     register IO *nstio;
     register IO *gstio;
+    struct sockaddr saddr;     /* use a struct to avoid alignment problems */
     int len = sizeof saddr;
     int fd;
 
@@ -1871,7 +1965,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;
 }
 
@@ -1881,7 +1975,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;
 }
 
@@ -1891,7 +1985,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;
 }
 
@@ -2127,6 +2221,7 @@ PP(pp_fttext)
     }
 
     /* now scan s to look for textiness */
+    /*   XXX ASCII dependent code */
 
     for (i = 0; i < len; i++, s++) {
        if (!*s) {                      /* null never allowed in text */
@@ -2141,7 +2236,7 @@ PP(pp_fttext)
            odd++;
     }
 
-    if ((odd * 30 > len) == (op->op_type == OP_FTTEXT)) /* allow 30% odd */
+    if ((odd * 3 > len) == (op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
        RETPUSHNO;
     else
        RETPUSHYES;
@@ -2179,7 +2274,7 @@ PP(pp_chdir)
 #ifdef VMS
     /* Clear the DEFAULT element of ENV so we'll get the new value
      * in the future. */
-    hv_delete(GvHVn(envgv),"DEFAULT",7);
+    hv_delete(GvHVn(envgv),"DEFAULT",7,G_DISCARD);
 #endif
     RETURN;
 }
@@ -2675,7 +2770,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);
@@ -2721,7 +2816,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);
@@ -2731,6 +2826,7 @@ PP(pp_system)
     else {
        value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
     }
+    statusvalue = FIXSTATUS(value);
     do_execfree();
     SP = ORIGMARK;
     PUSHi(value);
@@ -2806,8 +2902,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");
@@ -2836,8 +2932,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");
@@ -2911,6 +3007,8 @@ PP(pp_tms)
     (void)times((tbuffer_t *)&timesbuf);  /* time.h uses different name for */
                                           /* struct tms, though same data   */
                                           /* is returned.                   */
+#undef HZ
+#define HZ CLK_TCK
 #endif
 
     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
@@ -3194,7 +3292,8 @@ PP(pp_ghostent)
        PUSHs(sv = sv_newmortal());
        if (hent) {
            if (which == OP_GHBYNAME) {
-               sv_setpvn(sv, hent->h_addr, hent->h_length);
+               if (hent->h_addr)
+                   sv_setpvn(sv, hent->h_addr, hent->h_length);
            }
            else
                sv_setpv(sv, (char*)hent->h_name);
@@ -3223,7 +3322,8 @@ PP(pp_ghostent)
        }
 #else
        PUSHs(sv = sv_mortalcopy(&sv_no));
-       sv_setpvn(sv, hent->h_addr, len);
+       if (hent->h_addr)
+           sv_setpvn(sv, hent->h_addr, len);
 #endif /* h_addr */
     }
     RETURN;