#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, ...)
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;
}
}
if (fd >= 0) {
- PerlIOUnix *s;
if (*mode == 'I')
mode++;
if (!f) {
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 {
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;
}
}
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();
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();
SETERRNO(EINVAL, LIB_INVARG);
#endif
return -1;
- }
+ }
new = PerlLIO_lseek(fd, offset, whence);
if (new == (Off_t) - 1)
{
}
if (dupfd) {
PerlLIO_dup2(dupfd,fd);
- close(dupfd);
+ PerlLIO_close(dupfd);
}
return result;
}
}
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;
}
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;
}