X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/b4581f097130417ce397d3283decd4cd6b448ce9..166f8a29442475f7fe0e9216f957512a793bc4ed:/perlio.c

diff --git a/perlio.c b/perlio.c
index 8ea9ade..466bd17 100644
--- 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);
 
      /*