For now reword the sysread/syswrite description to
[p5sagit/p5-mst-13.2.git] / perlio.c
index e50f504..05b53c9 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -430,9 +430,11 @@ PerlIO_findFILE(PerlIO *pio)
 #include <sys/mman.h>
 #endif
 
-
+/*
+ * Why is this here - not in perlio.h?  RMB
+ */
 void PerlIO_debug(const char *fmt, ...)
-    __attribute__ ((format(__printf__, 1, 2)));
+    __attribute__format__(__printf__, 1, 2);
 
 void
 PerlIO_debug(const char *fmt, ...)
@@ -2329,29 +2331,41 @@ PerlIOUnix_fileno(pTHX_ PerlIO *f)
     return PerlIOSelf(f, PerlIOUnix)->fd;
 }
 
-IV
-PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+static void
+PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode)
 {
-    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
     PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
 #if defined(WIN32)
-    struct stat  st;
-    if (fstat(s->fd, &st) == 0) {
+    Stat_t st;
+    if (PerlLIO_fstat(fd, &st) == 0) {
        if (!S_ISREG(st.st_mode)) {
+           PerlIO_debug("%d is not regular file\n",fd);
            PerlIOBase(f)->flags |= PERLIO_F_NOTREG;
        }
+       else {
+           PerlIO_debug("%d _is_ a regular file\n",fd);
+       }
     }
 #endif
+    s->fd = fd;
+    s->oflags = imode;
+    PerlIOUnix_refcnt_inc(fd);
+}
+
+IV
+PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+{
+    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
     if (*PerlIONext(f)) {
        /* We never call down so do any pending stuff now */
        PerlIO_flush(PerlIONext(f));
-       s->fd = PerlIO_fileno(PerlIONext(f));
        /*
         * XXX could (or should) we retrieve the oflags from the open file
         * handle rather than believing the "mode" we are passed in? XXX
         * Should the value on NULL mode be 0 or -1?
         */
-       s->oflags = mode ? PerlIOUnix_oflags(mode) : -1;
+        PerlIOUnix_setfd(aTHX_ f, PerlIO_fileno(PerlIONext(f)),
+                         mode ? PerlIOUnix_oflags(mode) : -1);
     }
     PerlIOBase(f)->flags |= PERLIO_F_OPEN;
 
@@ -2380,7 +2394,6 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
        }
     }
     if (fd >= 0) {
-       PerlIOUnix *s;
        if (*mode == 'I')
            mode++;
        if (!f) {
@@ -2391,11 +2404,8 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                return NULL;
            }
        }
-       s = PerlIOSelf(f, PerlIOUnix);
-       s->fd = fd;
-       s->oflags = imode;
+        PerlIOUnix_setfd(aTHX_ f, fd, imode);
        PerlIOBase(f)->flags |= PERLIO_F_OPEN;
-       PerlIOUnix_refcnt_inc(fd);
        return f;
     }
     else {
@@ -2420,9 +2430,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
        f = PerlIOBase_dup(aTHX_ f, o, param, flags);
        if (f) {
            /* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */
-           PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
-           s->fd = fd;
-           PerlIOUnix_refcnt_inc(fd);
+           PerlIOUnix_setfd(aTHX_ f, fd, os->oflags);
            return f;
        }
     }
@@ -2441,10 +2449,15 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     while (1) {
        SSize_t len = PerlLIO_read(fd, vbuf, count);
        if (len >= 0 || errno != EINTR) {
-           if (len < 0)
-               PerlIOBase(f)->flags |= PERLIO_F_ERROR;
-           else if (len == 0 && count != 0)
+           if (len < 0) {
+               if (errno != EAGAIN) {
+                   PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+               }
+           }
+           else if (len == 0 && count != 0) {
                PerlIOBase(f)->flags |= PERLIO_F_EOF;
+               SETERRNO(0,0);
+           }
            return len;
        }
        PERL_ASYNC_CHECK();
@@ -2458,8 +2471,11 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     while (1) {
        SSize_t len = PerlLIO_write(fd, vbuf, count);
        if (len >= 0 || errno != EINTR) {
-           if (len < 0)
-               PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+           if (len < 0) {
+               if (errno != EAGAIN) {
+                   PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+               }
+           }
            return len;
        }
        PERL_ASYNC_CHECK();
@@ -2478,7 +2494,7 @@ PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
        SETERRNO(EINVAL, LIB_INVARG);
 #endif
        return -1;
-    } 
+    }
     new  = PerlLIO_lseek(fd, offset, whence);
     if (new == (Off_t) - 1)
      {
@@ -2935,7 +2951,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
        }
        if (dupfd) {
            PerlLIO_dup2(dupfd,fd);
-           close(dupfd);
+           PerlLIO_close(dupfd);
        }
        return result;
     }
@@ -2961,10 +2977,10 @@ PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
        }
        else
            got = PerlSIO_fread(vbuf, 1, count, s);
-       if (got || errno != EINTR)
+       if (got >= 0 || errno != EINTR)
            break;
        PERL_ASYNC_CHECK();
-       errno = 0;      /* just in case */
+       SETERRNO(0,0);  /* just in case */
     }
     return got;
 }
@@ -3034,10 +3050,10 @@ PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     for (;;) {
        got = PerlSIO_fwrite(vbuf, 1, count,
                              PerlIOSelf(f, PerlIOStdio)->stdio);
-       if (got || errno != EINTR)
+       if (got >= 0 || errno != EINTR)
            break;
        PERL_ASYNC_CHECK();
-       errno = 0;      /* just in case */
+       SETERRNO(0,0);  /* just in case */
     }
     return got;
 }