Fix broken splitpod program
[p5sagit/p5-mst-13.2.git] / pp_sys.c
index 25926a2..8253df9 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -176,6 +176,18 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
 
 #include "reentr.h"
 
+#ifdef __Lynx__
+/* Missing protos on LynxOS */
+void sethostent(int);
+void endhostent(void);
+void setnetent(int);
+void endnetent(void);
+void setprotoent(int);
+void endprotoent(void);
+void setservent(int);
+void endservent(void);
+#endif
+
 #undef PERL_EFF_ACCESS_R_OK    /* EFFective uid/gid ACCESS R_OK */
 #undef PERL_EFF_ACCESS_W_OK
 #undef PERL_EFF_ACCESS_X_OK
@@ -860,8 +872,8 @@ PP(pp_untie)
     if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv)))
        RETPUSHYES;
 
-    if ((mg = SvTIED_mg(sv, how)) && mg->mg_obj) {
-       SV *obj = SvRV(mg->mg_obj);
+    if ((mg = SvTIED_mg(sv, how))) {
+       SV *obj = SvRV(SvTIED_obj(sv, mg));
        GV *gv;
        CV *cv = NULL;
         if (obj) {
@@ -1024,15 +1036,19 @@ PP(pp_sselect)
     Zero(&fd_sets[0], 4, char*);
 #endif
 
-#  if SELECT_MIN_BITS > 1
+#  if SELECT_MIN_BITS == 1
+    growsize = sizeof(fd_set);
+#  else
+#   if defined(__GLIBC__) && defined(__FD_SETSIZE)
+#      undef SELECT_MIN_BITS
+#      define SELECT_MIN_BITS __FD_SETSIZE
+#   endif
     /* If SELECT_MIN_BITS is greater than one we most probably will want
      * to align the sizes with SELECT_MIN_BITS/8 because for example
      * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
      * UNIX, Solaris, NeXT, Darwin) the smallest quantum select() operates
      * on (sets/tests/clears bits) is 32 bits.  */
     growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
-#  else
-    growsize = sizeof(fd_set);
 #  endif
 
     sv = SP[4];
@@ -1575,7 +1591,7 @@ PP(pp_sysread)
     }
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
        buffer = SvPVutf8_force(bufsv, blen);
-       /* UTF8 may not have been set if they are all low bytes */
+       /* UTF-8 may not have been set if they are all low bytes */
        SvUTF8_on(bufsv);
     }
     else {
@@ -1807,9 +1823,12 @@ PP(pp_send)
        buffer = SvPVutf8(bufsv, blen);
     }
     else {
-       if (DO_UTF8(bufsv))
-           sv_utf8_downgrade(bufsv, FALSE);
-       buffer = SvPV(bufsv, blen);
+        if (DO_UTF8(bufsv)) {
+             /* Not modifying source SV, so making a temporary copy. */
+             bufsv = sv_2mortal(newSVsv(bufsv));
+             sv_utf8_downgrade(bufsv, FALSE);
+        }
+        buffer = SvPV(bufsv, blen);
     }
 
     if (PL_op->op_type == OP_SYSWRITE) {
@@ -3077,7 +3096,7 @@ PP(pp_ftmtime)
     dSP; dTARGET;
     if (result < 0)
        RETPUSHUNDEF;
-    PUSHn( (PL_basetime - PL_statcache.st_mtime) / 86400.0 );
+    PUSHn( (((NV)PL_basetime - PL_statcache.st_mtime)) / 86400.0 );
     RETURN;
 }
 
@@ -3087,7 +3106,7 @@ PP(pp_ftatime)
     dSP; dTARGET;
     if (result < 0)
        RETPUSHUNDEF;
-    PUSHn( (PL_basetime - PL_statcache.st_atime) / 86400.0 );
+    PUSHn( (((NV)PL_basetime - PL_statcache.st_atime)) / 86400.0 );
     RETURN;
 }
 
@@ -3097,7 +3116,7 @@ PP(pp_ftctime)
     dSP; dTARGET;
     if (result < 0)
        RETPUSHUNDEF;
-    PUSHn( (PL_basetime - PL_statcache.st_ctime) / 86400.0 );
+    PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 );
     RETURN;
 }
 
@@ -3789,48 +3808,43 @@ nope:
 
 PP(pp_readdir)
 {
-#if defined(Direntry_t) && defined(HAS_READDIR)
-    dSP;
+#if !defined(Direntry_t) || !defined(HAS_READDIR)
+    DIE(aTHX_ PL_no_dir_func, "readdir");
+#else
 #if !defined(I_DIRENT) && !defined(VMS)
     Direntry_t *readdir (DIR *);
 #endif
+    dSP;
+
+    SV *sv;
+    I32 gimme = GIMME;
+    GV *gv = (GV *)POPs;
     register Direntry_t *dp;
-    GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
-    SV *sv;
 
     if (!io || !IoDIRP(io))
        goto nope;
 
-    if (GIMME == G_ARRAY) {
-       /*SUPPRESS 560*/
-       while ((dp = (Direntry_t *)PerlDir_read(IoDIRP(io)))) {
+    do {
+        dp = (Direntry_t *)PerlDir_read(IoDIRP(io));
+        if (!dp)
+            break;
 #ifdef DIRNAMLEN
-           sv = newSVpvn(dp->d_name, dp->d_namlen);
+        sv = newSVpvn(dp->d_name, dp->d_namlen);
 #else
-           sv = newSVpv(dp->d_name, 0);
+        sv = newSVpv(dp->d_name, 0);
 #endif
 #ifndef INCOMPLETE_TAINTS
-           if (!(IoFLAGS(io) & IOf_UNTAINT))
-               SvTAINTED_on(sv);
-#endif
-           XPUSHs(sv_2mortal(sv));
-       }
-    }
-    else {
-       if (!(dp = (Direntry_t *)PerlDir_read(IoDIRP(io))))
-           goto nope;
-#ifdef DIRNAMLEN
-       sv = newSVpvn(dp->d_name, dp->d_namlen);
-#else
-       sv = newSVpv(dp->d_name, 0);
-#endif
-#ifndef INCOMPLETE_TAINTS
-       if (!(IoFLAGS(io) & IOf_UNTAINT))
-           SvTAINTED_on(sv);
+        if (!(IoFLAGS(io) & IOf_UNTAINT))
+            SvTAINTED_on(sv);
 #endif
-       XPUSHs(sv_2mortal(sv));
+        XPUSHs(sv_2mortal(sv));
     }
+    while (gimme == G_ARRAY);
+
+    if (!dp && gimme != G_ARRAY)
+        goto nope;
+
     RETURN;
 
 nope:
@@ -3840,8 +3854,6 @@ nope:
        RETURN;
     else
        RETPUSHUNDEF;
-#else
-    DIE(aTHX_ PL_no_dir_func, "readdir");
 #endif
 }
 
@@ -4138,8 +4150,6 @@ PP(pp_system)
            PerlLIO_close(pp[0]);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
            fcntl(pp[1], F_SETFD, FD_CLOEXEC);
-#else
-           PerlLIO_close(pp[1]); /* Do as best as we can: pretend success. */
 #endif
        }
        if (PL_op->op_flags & OPf_STACKED) {
@@ -5160,7 +5170,7 @@ PP(pp_gpwent)
      * AIX getpwnam() is clever enough to return the encrypted password
      * only if the caller (euid?) is root.
      *
-     * There are at least two other shadow password APIs.  Many platforms
+     * There are at least three other shadow password APIs.  Many platforms
      * seem to contain more than one interface for accessing the shadow
      * password databases, possibly for compatibility reasons.
      * The getsp*() is by far he simplest one, the other two interfaces
@@ -5182,6 +5192,12 @@ PP(pp_gpwent)
      * char *(getespw*(...).ufld.fd_encrypt)
      * Mention HAS_GETESPWNAM here so that Configure probes for it.
      *
+     * <userpw.h> (AIX)
+     * struct userpw *getuserpw();
+     * The password is in
+     * char *(getuserpw(...)).spw_upw_passwd
+     * (but the de facto standard getpwnam() should work okay)
+     *
      * Mention I_PROT here so that Configure probes for it.
      *
      * In HP-UX for getprpw*() the manual page claims that one should include
@@ -5204,6 +5220,12 @@ PP(pp_gpwent)
      * --jhi
      */
 
+#   if defined(__CYGWIN__) && defined(USE_REENTRANT_API)
+    /* Cygwin 1.5.3-1 has buggy getpwnam_r() and getpwuid_r():
+     * the pw_comment is left uninitialized. */
+    PL_reentrant_buffer->_pwent_struct.pw_comment = NULL;
+#   endif
+
     switch (which) {
     case OP_GPWNAM:
       {
@@ -5267,7 +5289,9 @@ PP(pp_gpwent)
         * Divert the urge to writing an extension instead.
         *
         * --jhi */
-#   ifdef HAS_GETSPNAM
+       /* Some AIX setups falsely(?) detect some getspnam(), which
+        * has a different API than the Solaris/IRIX one. */
+#   if defined(HAS_GETSPNAM) && !defined(_AIX)
        {
            struct spwd *spwent;
            int saverrno; /* Save and restore errno so that