Add comment to the top of most .c files explaining their purpose

[perl5.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index 8ea9ade..466bd17 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -1,5 +1,5 @@
 /*
- * perlio.c Copyright (c) 1996-2002, Nick Ing-Simmons You may distribute
+ * perlio.c Copyright (c) 1996-2004, Nick Ing-Simmons You may distribute
  * under the terms of either the GNU General Public License or the
  * Artistic License, as specified in the README file.
  */
@@ -9,6 +9,12 @@
  * over passes, and through long dales, and across many streams.
  */
 
+/* This file contains the functions needed to implement PerlIO, which
+ * is Perl's private replacement for the C stdio library. This is used
+ * by default unless you compile with -Uuseperlio or run with
+ * PERLIO=:stdio (but don't do this unless you know what you're doing)
+ */
+
 /*
  * If we have ActivePerl-like PERL_IMPLICIT_SYS then we need a dTHX to get
  * at the dispatch tables, even when we do not need it for other reasons.
@@ -50,6 +56,11 @@
 
 #include "XSUB.h"
 
+#ifdef __Lynx__
+/* Missing proto on LynxOS */
+int mkstemp(char*);
+#endif
+
 /* Call the callback or PerlIOBase, and return failure. */
 #define Perl_PerlIO_or_Base(f, callback, base, failure, args)  \
        if (PerlIOValid(f)) {                                   \
@@ -2608,8 +2619,10 @@ char *
 PerlIOStdio_mode(const char *mode, char *tmode)
 {
     char *ret = tmode;
-    while (*mode) {
-       *tmode++ = *mode++;
+    if (mode) {
+       while (*mode) {
+           *tmode++ = *mode++;
+       }
     }
 #if defined(PERLIO_USING_CRLF) || defined(__CYGWIN__)
     *tmode++ = 'b';
@@ -2868,6 +2881,10 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
      */
     f->_file = -1;
     return 1;
+#  elif defined(__EMX__)
+    /* f->_flags &= ~_IOOPEN; */       /* Will leak stream->_buffer */
+    f->_handle = -1;
+    return 1;
 #  elif defined(__CYGWIN__)
     /* There may be a better way on CYGWIN:
         - we could insert a dummy func in the _close function entry
@@ -3680,6 +3697,7 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     const STDCHAR *buf = (const STDCHAR *) vbuf;
+    const STDCHAR *flushptr = buf;
     Size_t written = 0;
     if (!b->buf)
        PerlIO_get_base(f);
@@ -3690,32 +3708,26 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
            return 0;
        }
     }  
+    if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF) {
+       flushptr = buf + count;
+       while (flushptr > buf && *(flushptr - 1) != '\n')
+           --flushptr;
+    }
     while (count > 0) {
        SSize_t avail = b->bufsiz - (b->ptr - b->buf);
        if ((SSize_t) count < avail)
            avail = count;
+       if (flushptr > buf && flushptr <= buf + avail)
+           avail = flushptr - buf;
        PerlIOBase(f)->flags |= PERLIO_F_WRBUF;
-       if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF) {
-           while (avail > 0) {
-               int ch = *buf++;
-               *(b->ptr)++ = ch;
-               count--;
-               avail--;
-               written++;
-               if (ch == '\n') {
-                   PerlIO_flush(f);
-                   break;
-               }
-           }
-       }
-       else {
-           if (avail) {
-               Copy(buf, b->ptr, avail, STDCHAR);
-               count -= avail;
-               buf += avail;
-               written += avail;
-               b->ptr += avail;
-           }
+       if (avail) {
+           Copy(buf, b->ptr, avail, STDCHAR);
+           count -= avail;
+           buf += avail;
+           written += avail;
+           b->ptr += avail;
+           if (buf == flushptr)
+               PerlIO_flush(f);
        }
        if (b->ptr >= (b->buf + b->bufsiz))
            PerlIO_flush(f);
@@ -4707,9 +4719,16 @@ PerlIO_getname(PerlIO *f, char *buf)
     dTHX;
     char *name = NULL;
 #ifdef VMS
+    bool exported = FALSE;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    if (stdio)
+    if (!stdio) {
+       stdio = PerlIO_exportFILE(f,0);
+       exported = TRUE;
+    }
+    if (stdio) {
        name = fgetname(stdio, buf);
+       if (exported) PerlIO_releaseFILE(f,stdio);
+    }
 #else
     Perl_croak(aTHX_ "Don't know how to get file name");
 #endif
@@ -4861,7 +4880,7 @@ PerlIO_tmpfile(void)
      if (fd >= 0)
          f = PerlIO_fdopen(fd, "w+b");
 #else /* WIN32 */
-#    ifdef HAS_MKSTEMP
+#    if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
      SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
 
      /*