Change files which are mysteriously different to mainline to be

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

diff --git a/perlio.c b/perlio.c
index defe71e..4ed8f03 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -7,7 +7,6 @@
  *
  */
 
-
 #define VOIDUSED 1
 #ifdef PERL_MICRO
 #   include "uconfig.h"
@@ -91,10 +90,14 @@ PerlIO_init(void)
 /* Implement all the PerlIO interface ourselves.
 */
 
+/* We _MUST_ have <unistd.h> if we are using lseek() and may have large files */
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+
 #undef printf
 void PerlIO_debug(char *fmt,...) __attribute__((format(printf,1,2)));
 
-
 void
 PerlIO_debug(char *fmt,...)
 {
@@ -134,25 +137,26 @@ PerlIO_debug(char *fmt,...)
 
 struct _PerlIO
 {
- IV       flags;
+ IV       flags;      /* Various flags for state */
  IV       fd;         /* Maybe pointer on some OSes */
  int      oflags;     /* open/fcntl flags */
  STDCHAR *buf;        /* Start of buffer */
  STDCHAR *end;        /* End of valid part of buffer */
  STDCHAR *ptr;        /* Current position in buffer */
  Size_t   bufsiz;     /* Size of buffer */
- Off_t    posn;
- int      oneword;
+ Off_t    posn;       /* Offset of f->buf into the file */
+ int      oneword;    /* An if-all-else-fails area as a buffer */
 };
 
-int _perlio_size     = 0;
+/* Table of pointers to the PerlIO structs (malloc'ed) */
 PerlIO **_perlio     = NULL;
+int _perlio_size     = 0;
 
 void
 PerlIO_alloc_buf(PerlIO *f)
 {
  if (!f->bufsiz)
-  f->bufsiz = 2;
+  f->bufsiz = 4096;
  New('B',f->buf,f->bufsiz,char);
  if (!f->buf)
   {
@@ -161,10 +165,12 @@ PerlIO_alloc_buf(PerlIO *f)
   }
  f->ptr = f->buf;
  f->end = f->ptr;
- PerlIO_debug(__FUNCTION__ " f=%p b=%p p=%p e=%p\n",
-                  f,f->buf,f->ptr,f->end);
 }
 
+
+/* This "flush" is akin to sfio's sync in that it handles files in either
+   read or write state
+*/
 #undef PerlIO_flush
 int
 PerlIO_flush(PerlIO *f)
@@ -172,10 +178,9 @@ PerlIO_flush(PerlIO *f)
  int code = 0;
  if (f)
   {
-   PerlIO_debug(__FUNCTION__ " f=%p flags=%08X c=%d buf=%p ptr=%p\n",
-                f,f->flags,(f->ptr-f->buf),f->buf,f->ptr);
    if (f->flags & PERLIO_F_WRBUF)
     {
+     /* write() the buffer */
      STDCHAR *p = f->buf;
      int count;
      while (p < f->ptr)
@@ -187,6 +192,7 @@ PerlIO_flush(PerlIO *f)
         }
        else if (count < 0 && errno != EINTR)
         {
+         f->flags |= PERLIO_F_ERROR;
          code = -1;
          break;
         }
@@ -195,9 +201,11 @@ PerlIO_flush(PerlIO *f)
     }
    else if (f->flags & PERLIO_F_RDBUF)
     {
+     /* Note position change */
      f->posn += (f->ptr - f->buf);
      if (f->ptr < f->end)
       {
+       /* We did not consume all of it */
        f->posn = lseek(f->fd,f->posn,SEEK_SET);
       }
     }
@@ -207,7 +215,7 @@ PerlIO_flush(PerlIO *f)
  else
   {
    int i;
-   for (i=_perlio_size; i >= 0; i--)
+   for (i=_perlio_size-1; i >= 0; i--)
     {
      if ((f = _perlio[i]))
       {
@@ -223,7 +231,6 @@ int
 PerlIO_oflags(const char *mode)
 {
  int oflags = -1;
- PerlIO_debug(__FUNCTION__ " %s = ",mode);
  switch(*mode)
   {
    case 'r':
@@ -247,7 +254,7 @@ PerlIO_oflags(const char *mode)
     break;
 
    case 'a':
-    oflags = O_CREAT|O_TRUNC|O_APPEND;
+    oflags = O_CREAT|O_APPEND;
     if (*++mode == '+')
      {
       oflags |= O_RDWR;
@@ -262,13 +269,13 @@ PerlIO_oflags(const char *mode)
    errno = EINVAL;
    oflags = -1;
   }
- PerlIO_debug(" %X '%s'\n",oflags,mode);
  return oflags;
 }
 
 PerlIO *
 PerlIO_allocate(void)
 {
+ /* Find a free slot in the table, growing table as necessary */
  PerlIO *f;
  int i = 0;
  while (1)
@@ -277,7 +284,6 @@ PerlIO_allocate(void)
    while (i < _perlio_size)
     {
      f = table[i];
-     PerlIO_debug(__FUNCTION__ " try %d %p\n",i,f);
      if (!f)
       {
        Newz('F',f,1,PerlIO);
@@ -318,7 +324,6 @@ PerlIO_fdopen(int fd, const char *mode)
      f->flags  |= (PERLIO_F_OPEN|PERLIO_F_USED);
     }
   }
- PerlIO_debug(__FUNCTION__ " fd=%d m=%s f=%p\n",fd,mode,f);
  return f;
 }
 
@@ -337,11 +342,19 @@ PerlIO_fileno(PerlIO *f)
 int
 PerlIO_close(PerlIO *f)
 {
- int code = -1;
+ int code = 0;
  if (f)
   {
-   PerlIO_flush(f);
-   while ((code = close(f->fd)) && errno == EINTR);
+   if (PerlIO_flush(f) != 0)
+    code = -1;
+   while (close(f->fd) != 0)
+    {
+     if (errno != EINTR)
+      {
+       code = -1;
+       break;
+      }
+    }
    f->flags &= ~PERLIO_F_OPEN;
    f->fd     = -1;
    if (f->buf && f->buf != (STDCHAR *) &f->oneword)
@@ -358,8 +371,8 @@ PerlIO_close(PerlIO *f)
 void
 PerlIO_cleanup(void)
 {
+ /* Close all the files */
  int i;
- PerlIO_debug(__FUNCTION__ "\n");
  for (i=_perlio_size-1; i >= 0; i--)
   {
    PerlIO *f = _perlio[i];
@@ -386,13 +399,11 @@ PerlIO_open(const char *path, const char *mode)
    int fd = open(path,oflags,0666);
    if (fd >= 0)
     {
-     PerlIO_debug(__FUNCTION__ "fd=%d\n",fd);
      f = PerlIO_fdopen(fd,mode);
      if (!f)
       close(fd);
     }
   }
- PerlIO_debug(__FUNCTION__ " path=%s m=%s f=%p\n",path,mode,f);
  return f;
 }
 
@@ -400,7 +411,6 @@ PerlIO_open(const char *path, const char *mode)
 PerlIO *
 PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
 {
- PerlIO_debug(__FUNCTION__ " n=%s m=%s f=%p\n",path,mode,f);
  if (f)
   {
    int oflags = PerlIO_oflags(mode);
@@ -410,7 +420,6 @@ PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
      int fd = open(path,oflags,0666);
      if (fd >= 0)
       {
-       PerlIO_debug(__FUNCTION__ "fd=%d\n",fd);
        f->oflags = oflags;
        f->flags  |= (PERLIO_F_OPEN|PERLIO_F_USED);
       }
@@ -433,7 +442,6 @@ PerlIO_init(void)
    PerlIO_fdopen(1,"w");
    PerlIO_fdopen(2,"w");
   }
- PerlIO_debug(__FUNCTION__ "\n");
 }
 
 #undef PerlIO_stdin
@@ -518,16 +526,16 @@ PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
 {
  if (f)
   {
-   dTHX;
    if (!f->buf)
     PerlIO_alloc_buf(f);
    f->ptr = ptr;
-   assert(f->ptr >= f->buf);
-   if (PerlIO_get_cnt(f) != cnt)
+   if (PerlIO_get_cnt(f) != cnt || f->ptr < f->buf)
     {
      dTHX;
-     assert(PerlIO_get_cnt(f) != cnt);
+     assert(PerlIO_get_cnt(f) == cnt);
+     assert(f->ptr >= f->buf);
     }
+   f->flags |= PERLIO_F_RDBUF;
   }
 }
 
@@ -605,20 +613,15 @@ PerlIO_eof(PerlIO *f)
 char *
 PerlIO_getname(PerlIO *f, char *buf)
 {
-#ifdef VMS
- return fgetname(f,buf);
-#else
  dTHX;
  Perl_croak(aTHX_ "Don't know how to get file name");
  return NULL;
-#endif
 }
 
 #undef PerlIO_ungetc
 int
 PerlIO_ungetc(PerlIO *f, int ch)
 {
- PerlIO_debug(__FUNCTION__ " f=%p c=%c\n",f,ch);
  if (f->buf && (f->flags & PERLIO_F_RDBUF) && f->ptr > f->buf)
   {
    *--(f->ptr) = ch;
@@ -637,7 +640,8 @@ PerlIO_read(PerlIO *f, void *vbuf, Size_t count)
    Size_t got = 0;
    if (!f->ptr)
     PerlIO_alloc_buf(f);
-
+   if ((f->oflags & (O_RDONLY|O_WRONLY|O_RDWR)) == O_WRONLY)
+    return 0;
    while (count > 0)
     {
      SSize_t avail = (f->end - f->ptr);
@@ -653,6 +657,7 @@ PerlIO_read(PerlIO *f, void *vbuf, Size_t count)
       }
      if (count && (f->ptr >= f->end))
       {
+       PerlIO_flush(f);
        f->ptr = f->end = f->buf;
        avail = read(f->fd,f->ptr,f->bufsiz);
        if (avail <= 0)
@@ -681,7 +686,7 @@ PerlIO_getc(PerlIO *f)
  STDCHAR buf;
  int count = PerlIO_read(f,&buf,1);
  if (count == 1)
-  return buf;
+  return (unsigned char) buf;
  return -1;
 }
 
@@ -722,15 +727,16 @@ PerlIO_write(PerlIO *f, const void *vbuf, Size_t count)
 {
  const STDCHAR *buf = (const STDCHAR *) vbuf;
  Size_t written = 0;
- PerlIO_debug(__FUNCTION__ " f=%p c=%d\n",f,count);
  if (f)
   {
    if (!f->buf)
     PerlIO_alloc_buf(f);
+   if ((f->oflags & (O_RDONLY|O_WRONLY|O_RDWR)) == O_RDONLY)
+    return 0;
    while (count > 0)
     {
-     Size_t avail = f->bufsiz - (f->ptr - f->buf);
-     if (count < avail)
+     SSize_t avail = f->bufsiz - (f->ptr - f->buf);
+     if ((SSize_t) count < avail)
       avail = count;
      f->flags |= PERLIO_F_WRBUF;
      if (f->flags & PERLIO_F_LINEBUF)
@@ -743,7 +749,10 @@ PerlIO_write(PerlIO *f, const void *vbuf, Size_t count)
          avail--;
          written++;
          if (ch == '\n')
-          PerlIO_flush(f);
+          {
+           PerlIO_flush(f);
+           break;
+          }
         }
       }
      else
@@ -769,14 +778,16 @@ int
 PerlIO_putc(PerlIO *f, int ch)
 {
  STDCHAR buf = ch;
- PerlIO_write(f,&ch,1);
+ PerlIO_write(f,&buf,1);
 }
 
 #undef PerlIO_tell
 Off_t
 PerlIO_tell(PerlIO *f)
 {
- Off_t posn = f->posn + (f->ptr - f->buf);
+ Off_t posn = f->posn;
+ if (f->buf)
+  posn += (f->ptr - f->buf);
  return posn;
 }
 
@@ -784,11 +795,12 @@ PerlIO_tell(PerlIO *f)
 int
 PerlIO_seek(PerlIO *f, Off_t offset, int whence)
 {
- int code = PerlIO_flush(f);
+ int code;
+ code = PerlIO_flush(f);
  if (code == 0)
   {
    f->flags &= ~PERLIO_F_EOF;
-   f->posn = lseek(f->fd,offset,whence);
+   f->posn = PerlLIO_lseek(f->fd,offset,whence);
    if (f->posn == (Off_t) -1)
     {
      f->posn = 0;
@@ -810,12 +822,12 @@ int
 PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
 {
  dTHX;
- SV *sv = newSV(strlen(fmt));
+ SV *sv = newSVpvn("",0);
  char *s;
  STRLEN len;
  sv_vcatpvf(sv, fmt, &ap);
  s = SvPV(sv,len);
- return (PerlIO_write(f,s,len) == len) ? 1 : 0;
+ return PerlIO_write(f,s,len);
 }
 
 #undef PerlIO_printf
@@ -847,12 +859,13 @@ PerlIO *
 PerlIO_tmpfile(void)
 {
  dTHX;
+ /* I have no idea how portable mkstemp() is ... */
  SV *sv = newSVpv("/tmp/PerlIO_XXXXXX",0);
  int fd = mkstemp(SvPVX(sv));
  PerlIO *f = NULL;
  if (fd >= 0)
   {
-   PerlIO *f = PerlIO_fdopen(fd,"w+");
+   f = PerlIO_fdopen(fd,"w+");
    if (f)
     {
      f->flags |= PERLIO_F_TEMP;
@@ -868,6 +881,7 @@ PerlIO *
 PerlIO_importFILE(FILE *f, int fl)
 {
  int fd = fileno(f);
+ /* Should really push stdio discipline when we have them */
  return PerlIO_fdopen(fd,"r+");
 }
 
@@ -876,6 +890,7 @@ FILE *
 PerlIO_exportFILE(PerlIO *f, int fl)
 {
  PerlIO_flush(f);
+ /* Should really push stdio discipline when we have them */
  return fdopen(PerlIO_fileno(f),"r+");
 }