Correct change 23437 - as Config isn't imported, need to use a fully

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

diff --git a/perlio.c b/perlio.c
index cda36f8..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.
@@ -2875,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
@@ -3687,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);
@@ -3697,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);
@@ -4714,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