Patch for 'perldoc -f'

[p5sagit/p5-mst-13.2.git] / doio.c

diff --git a/doio.c b/doio.c
index d5b3cc8..a52df3e 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,6 +1,6 @@
 /*    doio.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, 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.
@@ -34,7 +34,11 @@
 #endif
 
 #ifdef I_UTIME
-#include <utime.h>
+#  ifdef WIN32
+#    include <sys/utime.h>
+#  else
+#    include <utime.h>
+#  endif
 #endif
 #ifdef I_FCNTL
 #include <fcntl.h>
@@ -43,6 +47,15 @@
 #include <sys/file.h>
 #endif
 
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+/* XXX If this causes problems, set i_unistd=undef in the hint file.  */
+#ifdef I_UNISTD
+#  include <unistd.h>
+#endif
+
 #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
 # include <sys/socket.h>
 # include <netdb.h>
@@ -53,6 +66,15 @@
 # endif
 #endif
 
+/* Put this after #includes because <unistd.h> defines _XOPEN_*. */
+#ifndef Sock_size_t
+#  if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED)
+#    define Sock_size_t Size_t
+#  else
+#    define Sock_size_t int
+#  endif
+#endif
+
 bool
 do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
 GV *gv;
@@ -109,9 +131,16 @@ PerlIO *supplied_fp;
        if (fd == -1)
            fp = NULL;
        else {
-           fp = PerlIO_fdopen(fd, ((result == 0) ? "r"
-                            : (result == 1) ? "w"
-                            : "r+"));
+           char *fpmode;
+           if (result == 0)
+               fpmode = "r";
+#ifdef O_APPEND
+           else if (rawmode & O_APPEND)
+               fpmode = (result == 1) ? "a" : "a+";
+#endif
+           else
+               fpmode = (result == 1) ? "w" : "r+";
+           fp = PerlIO_fdopen(fd, fpmode);
            if (!fp)
                close(fd);
        }
@@ -268,9 +297,10 @@ PerlIO *supplied_fp;
            !statbuf.st_mode
 #endif
        ) {
-           int buflen = sizeof tokenbuf;
-           if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
-               || errno != ENOTSOCK)
+           Sock_size_t buflen = sizeof tokenbuf;
+           if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf,
+                           &buflen) >= 0
+                 || errno != ENOTSOCK)
                IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
                                /* but some return 0 for streams too, sigh */
        }
@@ -409,7 +439,7 @@ register GV *gv;
                    (void)unlink(SvPVX(sv));
                    (void)rename(oldname,SvPVX(sv));
                    do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp);
-#endif /* MSDOS */
+#endif /* DOSISH */
 #else
                    (void)UNLINK(SvPVX(sv));
                    if (link(oldname,SvPVX(sv)) < 0) {
@@ -422,13 +452,15 @@ register GV *gv;
 #endif
                }
                else {
-#ifndef DOSISH
+#if !defined(DOSISH) && !defined(AMIGAOS)
+#  ifndef VMS  /* Don't delete; use automatic file versioning */
                    if (UNLINK(oldname) < 0) {
                        warn("Can't rename %s to %s: %s, skipping file",
                          oldname, SvPVX(sv), Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
+#  endif
 #else
                    croak("Can't do inplace edit without backup");
 #endif
@@ -566,8 +598,8 @@ IO* io;
     if (IoIFP(io)) {
        if (IoTYPE(io) == '|') {
            status = my_pclose(IoIFP(io));
-           retval = (status == 0);
-           statusvalue = FIXSTATUS(status);
+           STATUS_NATIVE_SET(status);
+           retval = (STATUS_POSIX == 0);
        }
        else if (IoTYPE(io) == '-')
            retval = TRUE;
@@ -731,56 +763,6 @@ Off_t length;              /* length to set file to */
 }
 #endif /* F_FREESP */
 
-I32
-looks_like_number(sv)
-SV *sv;
-{
-    register char *s;
-    register char *send;
-
-    if (!SvPOK(sv)) {
-       STRLEN len;
-       if (!SvPOKp(sv))
-           return TRUE;
-       s = SvPV(sv, len);
-       send = s + len;
-    }
-    else {
-       s = SvPVX(sv); 
-       send = s + SvCUR(sv);
-    }
-    while (isSPACE(*s))
-       s++;
-    if (s >= send)
-       return FALSE;
-    if (*s == '+' || *s == '-')
-       s++;
-    while (isDIGIT(*s))
-       s++;
-    if (s == send)
-       return TRUE;
-    if (*s == '.') 
-       s++;
-    else if (s == SvPVX(sv))
-       return FALSE;
-    while (isDIGIT(*s))
-       s++;
-    if (s == send)
-       return TRUE;
-    if (*s == 'e' || *s == 'E') {
-       s++;
-       if (*s == '+' || *s == '-')
-           s++;
-       while (isDIGIT(*s))
-           s++;
-    }
-    while (isSPACE(*s))
-       s++;
-    if (s >= send)
-       return TRUE;
-    return FALSE;
-}
-
 bool
 do_print(sv,fp)
 register SV *sv;
@@ -1016,7 +998,7 @@ char *cmd;
                break;
            }
          doshell:
-           execl(SH_PATH, "sh", "-c", cmd, (char*)0);
+           execl(sh_path, "sh", "-c", cmd, (char*)0);
            return FALSE;
        }
     }
@@ -1046,7 +1028,7 @@ char *cmd;
     return FALSE;
 }
 
-#endif 
+#endif /* OS2 */
 
 I32
 apply(type,mark,sp)
@@ -1062,9 +1044,10 @@ register SV **sp;
 
     if (tainting) {
        while (++mark <= sp) {
-           MAGIC *mg;
-           if (SvMAGICAL(*mark) && (mg = mg_find(*mark, 't')) && mg->mg_len & 1)
-               tainted = TRUE;
+           if (SvTAINTED(*mark)) {
+               TAINT;
+               break;
+           }
        }
        mark = oldmark;
     }
@@ -1097,6 +1080,8 @@ register SV **sp;
 #ifdef HAS_KILL
     case OP_KILL:
        TAINT_PROPER("kill");
+       if (mark == sp)
+           break;
        s = SvPVx(*++mark, na);
        tot = sp - mark;
        if (isUPPER(*s)) {
@@ -1247,7 +1232,7 @@ register struct stat *statbufp;
       */
      return (bit & statbufp->st_mode) ? TRUE : FALSE;
 
-#else /* ! MSDOS */
+#else /* ! DOSISH */
     if ((effective ? euid : uid) == 0) {       /* root is special */
        if (bit == S_IXUSR) {
            if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
@@ -1268,7 +1253,7 @@ register struct stat *statbufp;
     else if (statbufp->st_mode & bit >> 6)
        return TRUE;    /* ok as "other" */
     return FALSE;
-#endif /* ! MSDOS */
+#endif /* ! DOSISH */
 }
 #endif /* ! VMS */
 
@@ -1399,13 +1384,13 @@ SV **sp;
        {
            a = SvPV(astr, len);
            if (len != infosize)
-               croak("Bad arg length for %s, is %d, should be %d",
-                       op_desc[optype], len, infosize);
+               croak("Bad arg length for %s, is %lu, should be %ld",
+                       op_desc[optype], (unsigned long)len, (long)infosize);
        }
     }
     else
     {
-       I32 i = SvIV(astr);
+       IV i = SvIV(astr);
        a = (char *)i;          /* ouch */
     }
     SETERRNO(0,0);