#endif
/*
* This file provides those parts of PerlIO abstraction
- * which are not #defined in iperlsys.h.
+ * which are not #defined in perlio.h.
* Which these are depends on various Configure #ifdef's
*/
#define PERL_IN_PERLIO_C
#include "perl.h"
+#ifndef PERLIO_LAYERS
+int
+PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
+{
+ if (!names || !*names || strEQ(names,":crlf") || strEQ(names,":raw"))
+ {
+ return 0;
+ }
+ Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl",names);
+ /* NOTREACHED */
+ return -1;
+}
+
+int
+PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
+{
+/* This used to be contents of do_binmode in doio.c */
+#ifdef DOSISH
+# if defined(atarist) || defined(__MINT__)
+ if (!PerlIO_flush(fp)) {
+ if (mode & O_BINARY)
+ ((FILE*)fp)->_flag |= _IOBIN;
+ else
+ ((FILE*)fp)->_flag &= ~ _IOBIN;
+ return 1;
+ }
+ return 0;
+# else
+ if (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1) {
+# if defined(WIN32) && defined(__BORLANDC__)
+ /* The translation mode of the stream is maintained independent
+ * of the translation mode of the fd in the Borland RTL (heavy
+ * digging through their runtime sources reveal). User has to
+ * set the mode explicitly for the stream (though they don't
+ * document this anywhere). GSAR 97-5-24
+ */
+ PerlIO_seek(fp,0L,0);
+ if (mode & O_BINARY)
+ ((FILE*)fp)->flags |= _F_BIN;
+ else
+ ((FILE*)fp)->flags &= ~ _F_BIN;
+# endif
+ return 1;
+ }
+ else
+ return 0;
+# endif
+#else
+# if defined(USEMYBINMODE)
+ if (my_binmode(fp, iotype, mode) != FALSE)
+ return 1;
+ else
+ return 0;
+# else
+ return 1;
+# endif
+#endif
+}
+
+
+
+
+#endif
+
#if !defined(PERL_IMPLICIT_SYS)
#ifdef PERLIO_IS_STDIO
#include "XSUB.h"
-void PerlIO_debug(char *fmt,...) __attribute__((format(__printf__,1,2)));
+void PerlIO_debug(const char *fmt,...) __attribute__((format(__printf__,1,2)));
void
-PerlIO_debug(char *fmt,...)
+PerlIO_debug(const char *fmt,...)
{
static int dbg = 0;
+ va_list ap;
+ va_start(ap,fmt);
if (!dbg)
{
char *s = PerlEnv_getenv("PERLIO_DEBUG");
if (dbg > 0)
{
dTHX;
- va_list ap;
SV *sv = newSVpvn("",0);
char *s;
STRLEN len;
- va_start(ap,fmt);
s = CopFILE(PL_curcop);
if (!s)
s = "(none)";
s = SvPV(sv,len);
PerlLIO_write(dbg,s,len);
- va_end(ap);
SvREFCNT_dec(sv);
}
+ va_end(ap);
}
/*--------------------------------------------------------------------------------------*/
{
PerlIO *f = table+i;
if (*f)
- PerlIO_close(f);
+ {
+ PerlIO_close(f);
+ }
}
Safefree(table);
*tablep = NULL;
}
}
-#undef PerlIO_close
-int
-PerlIO_close(PerlIO *f)
-{
- int code = (*PerlIOBase(f)->tab->Close)(f);
- while (*f)
- {
- PerlIO_pop(f);
- }
- return code;
-}
-
-
/*--------------------------------------------------------------------------------------*/
-/* Given the abstraction above the public API functions */
-
-#undef PerlIO_fileno
-int
-PerlIO_fileno(PerlIO *f)
-{
- return (*PerlIOBase(f)->tab->Fileno)(f);
-}
+/* XS Interface for perl code */
-XS(XS_io_import)
+XS(XS_perlio_import)
{
dXSARGS;
GV *gv = CvGV(cv);
XSRETURN_EMPTY;
}
-XS(XS_io_unimport)
+XS(XS_perlio_unimport)
{
dXSARGS;
GV *gv = CvGV(cv);
}
SV *
-PerlIO_find_layer(char *name, STRLEN len)
+PerlIO_find_layer(const char *name, STRLEN len)
{
dTHX;
SV **svp;
{
if (SvROK(sv))
{
- IO *io = GvIOn(SvRV(sv));
+ IO *io = GvIOn((GV *)SvRV(sv));
PerlIO *ifp = IoIFP(io);
PerlIO *ofp = IoOFP(io);
AV *av = (AV *) mg->mg_obj;
{
if (SvROK(sv))
{
- IO *io = GvIOn(SvRV(sv));
+ IO *io = GvIOn((GV *)SvRV(sv));
PerlIO *ifp = IoIFP(io);
PerlIO *ofp = IoOFP(io);
AV *av = (AV *) mg->mg_obj;
for (i=2; i < items; i++)
{
STRLEN len;
- char *name = SvPV(ST(i),len);
+ const char *name = SvPV(ST(i),len);
SV *layer = PerlIO_find_layer(name,len);
if (layer)
{
PerlIO_define_layer(PerlIO_funcs *tab)
{
dTHX;
- HV *stash = gv_stashpv("io::Layer", TRUE);
+ HV *stash = gv_stashpv("perlio::Layer", TRUE);
SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))),stash);
hv_store(PerlIO_layer_hv,tab->name,strlen(tab->name),sv,0);
}
int len;
if (!PerlIO_layer_hv)
{
- char *s = PerlEnv_getenv("PERLIO");
- newXS("io::import",XS_io_import,__FILE__);
- newXS("io::unimport",XS_io_unimport,__FILE__);
+ const char *s = PerlEnv_getenv("PERLIO");
+ newXS("perlio::import",XS_perlio_import,__FILE__);
+ newXS("perlio::unimport",XS_perlio_unimport,__FILE__);
+#if 0
newXS("io::MODIFY_SCALAR_ATTRIBUTES",XS_io_MODIFY_SCALAR_ATTRIBUTES,__FILE__);
- PerlIO_layer_hv = get_hv("io::layers",GV_ADD|GV_ADDMULTI);
- PerlIO_layer_av = get_av("io::layers",GV_ADD|GV_ADDMULTI);
+#endif
+ PerlIO_layer_hv = get_hv("open::layers",GV_ADD|GV_ADDMULTI);
+ PerlIO_layer_av = get_av("open::layers",GV_ADD|GV_ADDMULTI);
PerlIO_define_layer(&PerlIO_unix);
PerlIO_define_layer(&PerlIO_perlio);
PerlIO_define_layer(&PerlIO_stdio);
+ PerlIO_define_layer(&PerlIO_crlf);
#ifdef HAS_MMAP
PerlIO_define_layer(&PerlIO_mmap);
#endif
s++;
if (*s)
{
- char *e = s;
+ const char *e = s;
SV *layer;
while (*e && !isSPACE((unsigned char)*e))
e++;
+ if (*s == ':')
+ s++;
layer = PerlIO_find_layer(s,e-s);
if (layer)
{
return f;
}
+int
+PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
+{
+ if (names)
+ {
+ const char *s = names;
+ while (*s)
+ {
+ while (isSPACE(*s))
+ s++;
+ if (*s == ':')
+ s++;
+ if (*s)
+ {
+ const char *e = s;
+ while (*e && *e != ':' && !isSPACE(*e))
+ e++;
+ if (e > s)
+ {
+ if ((e - s) == 3 && strncmp(s,"raw",3) == 0)
+ {
+ /* Pop back to bottom layer */
+ if (PerlIONext(f))
+ {
+ PerlIO_flush(f);
+ while (PerlIONext(f))
+ {
+ PerlIO_pop(f);
+ }
+ }
+ }
+ else
+ {
+ SV *layer = PerlIO_find_layer(s,e-s);
+ if (layer)
+ {
+ PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer)));
+ if (tab)
+ {
+ PerlIO *new = PerlIO_push(f,tab,mode);
+ if (!new)
+ return -1;
+ }
+ }
+ else
+ Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(int)(e-s),s);
+ }
+ }
+ s = e;
+ }
+ }
+ }
+ return 0;
+}
+
+
+
+/*--------------------------------------------------------------------------------------*/
+/* Given the abstraction above the public API functions */
+
+int
+PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
+{
+ if (!names || (O_TEXT != O_BINARY && mode & O_BINARY))
+ {
+ PerlIO *top = fp;
+ PerlIOl *l;
+ while (l = *top)
+ {
+ if (PerlIOBase(top)->tab == &PerlIO_crlf)
+ {
+ PerlIO_flush(top);
+ PerlIO_pop(top);
+ break;
+ }
+ top = PerlIONext(top);
+ }
+ }
+ return PerlIO_apply_layers(aTHX_ fp, NULL, names) == 0 ? TRUE : FALSE;
+}
+
+#undef PerlIO_close
+int
+PerlIO_close(PerlIO *f)
+{
+ int code = (*PerlIOBase(f)->tab->Close)(f);
+ while (*f)
+ {
+ PerlIO_pop(f);
+ }
+ return code;
+}
+
+#undef PerlIO_fileno
+int
+PerlIO_fileno(PerlIO *f)
+{
+ return (*PerlIOBase(f)->tab->Fileno)(f);
+}
+
+
+
#undef PerlIO_fdopen
PerlIO *
PerlIO_fdopen(int fd, const char *mode)
oflags |= O_WRONLY;
break;
}
+ if (*mode == 'b')
+ {
+ oflags |= O_BINARY;
+ mode++;
+ }
+ /* Always open in binary mode */
+ oflags |= O_BINARY;
if (*mode || oflags == -1)
{
errno = EINVAL;
IV
PerlIOStdio_close(PerlIO *f)
{
- return fclose(PerlIOSelf(f,PerlIOStdio)->stdio);
+ int optval, optlen = sizeof(int);
+ FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
+ return(
+ (getsockopt(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (char *)&optval, &optlen) < 0) ?
+ fclose(stdio) :
+ close(PerlIO_fileno(f)));
}
IV
PerlIOStdio_flush(PerlIO *f)
{
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
- return fflush(stdio);
+ if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
+ {
+ return fflush(stdio);
+ }
+ else
+ {
+#if 0
+ /* FIXME: This discards ungetc() and pre-read stuff which is
+ not right if this is just a "sync" from a layer above
+ Suspect right design is to do _this_ but not have layer above
+ flush this layer read-to-read
+ */
+ /* Not writeable - sync by attempting a seek */
+ int err = errno;
+ if (fseek(stdio,(Off_t) 0, SEEK_CUR) != 0)
+ errno = err;
+#endif
+ }
+ return 0;
}
IV
{
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
int c;
- if (fflush(stdio) != 0)
- return EOF;
+ /* fflush()ing read-only streams can cause trouble on some stdio-s */
+ if ((PerlIOBase(f)->flags & PERLIO_F_CANWRITE))
+ {
+ if (fflush(stdio) != 0)
+ return EOF;
+ }
c = fgetc(stdio);
if (c == EOF || ungetc(c,stdio) != c)
return EOF;
/* write() the buffer */
STDCHAR *p = b->buf;
int count;
+ PerlIO *n = PerlIONext(f);
while (p < b->ptr)
{
- count = PerlIO_write(PerlIONext(f),p,b->ptr - p);
+ count = PerlIO_write(n,p,b->ptr - p);
if (count > 0)
{
p += count;
}
- else if (count < 0)
+ else if (count < 0 || PerlIO_error(n))
{
PerlIOBase(f)->flags |= PERLIO_F_ERROR;
code = -1;
}
b->ptr = b->end = b->buf;
PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
+ /* FIXME: Is this right for read case ? */
if (PerlIO_flush(PerlIONext(f)) != 0)
code = -1;
return code;
PerlIOBuf_fill(PerlIO *f)
{
PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
+ PerlIO *n = PerlIONext(f);
SSize_t avail;
+ /* FIXME: doing the down-stream flush is a bad idea if it causes
+ pre-read data in stdio buffer to be discarded
+ but this is too simplistic - as it skips _our_ hosekeeping
+ and breaks tell tests.
+ if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF))
+ {
+ }
+ */
if (PerlIO_flush(f) != 0)
return -1;
+
b->ptr = b->end = b->buf;
- avail = PerlIO_read(PerlIONext(f),b->ptr,b->bufsiz);
+ if (PerlIO_fast_gets(n))
+ {
+ /* Layer below is also buffered
+ * We do _NOT_ want to call its ->Read() because that will loop
+ * till it gets what we asked for which may hang on a pipe etc.
+ * Instead take anything it has to hand, or ask it to fill _once_.
+ */
+ avail = PerlIO_get_cnt(n);
+ if (avail <= 0)
+ {
+ avail = PerlIO_fill(n);
+ if (avail == 0)
+ avail = PerlIO_get_cnt(n);
+ else
+ {
+ if (!PerlIO_error(n) && PerlIO_eof(n))
+ avail = 0;
+ }
+ }
+ if (avail > 0)
+ {
+ STDCHAR *ptr = PerlIO_get_ptr(n);
+ SSize_t cnt = avail;
+ if (avail > b->bufsiz)
+ avail = b->bufsiz;
+ Copy(ptr,b->buf,avail,STDCHAR);
+ PerlIO_set_ptrcnt(n,ptr+avail,cnt-avail);
+ }
+ }
+ else
+ {
+ avail = PerlIO_read(n,b->ptr,b->bufsiz);
+ }
if (avail <= 0)
{
if (avail == 0)
SSize_t
PerlIOBuf_read(PerlIO *f, void *vbuf, Size_t count)
{
- PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
- STDCHAR *buf = (STDCHAR *) vbuf;
+ PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
+ STDCHAR *buf = (STDCHAR *) vbuf;
if (f)
{
- Size_t got = 0;
if (!b->ptr)
PerlIO_get_base(f);
if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
return 0;
while (count > 0)
{
- SSize_t avail = (b->end - b->ptr);
- if ((SSize_t) count < avail)
- avail = count;
- if (avail > 0)
+ SSize_t avail = PerlIO_get_cnt(f);
+ SSize_t take = (count < avail) ? count : avail;
+ if (take > 0)
{
- Copy(b->ptr,buf,avail,char);
- got += avail;
- b->ptr += avail;
- count -= avail;
- buf += avail;
+ STDCHAR *ptr = PerlIO_get_ptr(f);
+ Copy(ptr,buf,take,STDCHAR);
+ PerlIO_set_ptrcnt(f,ptr+take,(avail -= take));
+ count -= take;
+ buf += take;
}
- if (count && (b->ptr >= b->end))
+ if (count > 0 && avail <= 0)
{
if (PerlIO_fill(f) != 0)
break;
}
}
- return got;
+ return (buf - (STDCHAR *) vbuf);
}
return 0;
}
buf -= avail;
if (buf != b->ptr)
{
- Copy(buf,b->ptr,avail,char);
+ Copy(buf,b->ptr,avail,STDCHAR);
}
count -= avail;
unread += avail;
{
if (avail)
{
- Copy(buf,b->ptr,avail,char);
+ Copy(buf,b->ptr,avail,STDCHAR);
count -= avail;
buf += avail;
written += avail;
PerlIOBuf_set_ptrcnt,
};
+/*--------------------------------------------------------------------------------------*/
+/* crlf - translation
+ On read translate CR,LF to "\n" we do this by overriding ptr/cnt entries
+ to hand back a line at a time and keeping a record of which nl we "lied" about.
+ On write translate "\n" to CR,LF
+ */
+
+typedef struct
+{
+ PerlIOBuf base; /* PerlIOBuf stuff */
+ STDCHAR *nl; /* Position of crlf we "lied" about in the buffer */
+} PerlIOCrlf;
+
+SSize_t
+PerlIOCrlf_unread(PerlIO *f, const void *vbuf, Size_t count)
+{
+ const STDCHAR *buf = (const STDCHAR *) vbuf+count;
+ PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
+ PerlIOCrlf *c = PerlIOSelf(f,PerlIOCrlf);
+ SSize_t unread = 0;
+ if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
+ PerlIO_flush(f);
+ if (c->nl)
+ {
+ *(c->nl) = 0xd;
+ c->nl = NULL;
+ }
+ if (!b->buf)
+ PerlIO_get_base(f);
+ if (b->buf)
+ {
+ if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF))
+ {
+ b->end = b->ptr = b->buf + b->bufsiz;
+ PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
+ }
+ while (count > 0 && b->ptr > b->buf)
+ {
+ int ch = *--buf;
+ if (ch == '\n')
+ {
+ if (b->ptr - 2 >= b->buf)
+ {
+ *--(b->ptr) = 0xa;
+ *--(b->ptr) = 0xd;
+ unread++;
+ count--;
+ }
+ else
+ {
+ buf++;
+ break;
+ }
+ }
+ else
+ {
+ *--(b->ptr) = ch;
+ unread++;
+ count--;
+ }
+ }
+ }
+ return unread;
+}
+
+SSize_t
+PerlIOCrlf_get_cnt(PerlIO *f)
+{
+ PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
+ if (!b->buf)
+ PerlIO_get_base(f);
+ if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
+ {
+ PerlIOCrlf *c = PerlIOSelf(f,PerlIOCrlf);
+ if (!c->nl)
+ {
+ STDCHAR *nl = b->ptr;
+ scan:
+ while (nl < b->end && *nl != 0xd)
+ nl++;
+ if (nl < b->end && *nl == 0xd)
+ {
+ test:
+ if (nl+1 < b->end)
+ {
+ if (nl[1] == 0xa)
+ {
+ *nl = '\n';
+ c->nl = nl;
+ }
+ else
+ {
+ /* Not CR,LF but just CR */
+ nl++;
+ goto scan;
+ }
+ }
+ else
+ {
+ /* Blast - found CR as last char in buffer */
+ if (b->ptr < nl)
+ {
+ /* They may not care, defer work as long as possible */
+ return (nl - b->ptr);
+ }
+ else
+ {
+ int code;
+ dTHX;
+ b->ptr++; /* say we have read it as far as flush() is concerned */
+ b->buf++; /* Leave space an front of buffer */
+ b->bufsiz--; /* Buffer is thus smaller */
+ code = PerlIO_fill(f); /* Fetch some more */
+ b->bufsiz++; /* Restore size for next time */
+ b->buf--; /* Point at space */
+ b->ptr = nl = b->buf; /* Which is what we hand off */
+ b->posn--; /* Buffer starts here */
+ *nl = 0xd; /* Fill in the CR */
+ if (code == 0)
+ goto test; /* fill() call worked */
+ /* CR at EOF - just fall through */
+ }
+ }
+ }
+ }
+ return (((c->nl) ? (c->nl+1) : b->end) - b->ptr);
+ }
+ return 0;
+}
+
+void
+PerlIOCrlf_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt)
+{
+ PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
+ PerlIOCrlf *c = PerlIOSelf(f,PerlIOCrlf);
+ if (!b->buf)
+ PerlIO_get_base(f);
+ if (!ptr)
+ {
+ if (c->nl)
+ ptr = c->nl+1;
+ else
+ {
+ ptr = b->end;
+ if (ptr > b->buf && ptr[-1] == 0xd)
+ ptr--;
+ }
+ ptr -= cnt;
+ }
+ else
+ {
+ /* Test code - delete when it works ... */
+ STDCHAR *chk;
+ if (c->nl)
+ chk = c->nl+1;
+ else
+ {
+ chk = b->end;
+ if (chk > b->buf && chk[-1] == 0xd)
+ chk--;
+ }
+ chk -= cnt;
+
+ if (ptr != chk)
+ {
+ dTHX;
+ Perl_croak(aTHX_ "ptr wrong %p != %p nl=%p e=%p for %d",
+ ptr, chk, c->nl, b->end, cnt);
+ }
+ }
+ if (c->nl)
+ {
+ if (ptr > c->nl)
+ {
+ /* They have taken what we lied about */
+ *(c->nl) = 0xd;
+ c->nl = NULL;
+ ptr++;
+ }
+ }
+ b->ptr = ptr;
+ PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
+}
+
+SSize_t
+PerlIOCrlf_write(PerlIO *f, const void *vbuf, Size_t count)
+{
+ PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
+ const STDCHAR *buf = (const STDCHAR *) vbuf;
+ const STDCHAR *ebuf = buf+count;
+ if (!b->buf)
+ PerlIO_get_base(f);
+ if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE))
+ return 0;
+ while (buf < ebuf)
+ {
+ STDCHAR *eptr = b->buf+b->bufsiz;
+ PerlIOBase(f)->flags |= PERLIO_F_WRBUF;
+ while (buf < ebuf && b->ptr < eptr)
+ {
+ if (*buf == '\n')
+ {
+ if ((b->ptr + 2) > eptr)
+ {
+ /* Not room for both */
+ PerlIO_flush(f);
+ break;
+ }
+ else
+ {
+ *(b->ptr)++ = 0xd; /* CR */
+ *(b->ptr)++ = 0xa; /* LF */
+ buf++;
+ if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF)
+ {
+ PerlIO_flush(f);
+ break;
+ }
+ }
+ }
+ else
+ {
+ int ch = *buf++;
+ *(b->ptr)++ = ch;
+ }
+ if (b->ptr >= eptr)
+ {
+ PerlIO_flush(f);
+ break;
+ }
+ }
+ }
+ return (buf - (STDCHAR *) vbuf);
+}
+
+IV
+PerlIOCrlf_flush(PerlIO *f)
+{
+ PerlIOCrlf *c = PerlIOSelf(f,PerlIOCrlf);
+ if (c->nl)
+ {
+ *(c->nl) = 0xd;
+ c->nl = NULL;
+ }
+ return PerlIOBuf_flush(f);
+}
+
+PerlIO_funcs PerlIO_crlf = {
+ "crlf",
+ sizeof(PerlIOCrlf),
+ 0,
+ PerlIOBase_fileno,
+ PerlIOBuf_fdopen,
+ PerlIOBuf_open,
+ PerlIOBuf_reopen,
+ PerlIOBase_pushed,
+ PerlIOBase_noop_ok, /* popped */
+ PerlIOBuf_read, /* generic read works with ptr/cnt lies ... */
+ PerlIOCrlf_unread, /* Put CR,LF in buffer for each '\n' */
+ PerlIOCrlf_write, /* Put CR,LF in buffer for each '\n' */
+ PerlIOBuf_seek,
+ PerlIOBuf_tell,
+ PerlIOBuf_close,
+ PerlIOCrlf_flush,
+ PerlIOBuf_fill,
+ PerlIOBase_eof,
+ PerlIOBase_error,
+ PerlIOBase_clearerr,
+ PerlIOBuf_setlinebuf,
+ PerlIOBuf_get_base,
+ PerlIOBuf_bufsiz,
+ PerlIOBuf_get_ptr,
+ PerlIOCrlf_get_cnt,
+ PerlIOCrlf_set_ptrcnt,
+};
+
#ifdef HAS_MMAP
/*--------------------------------------------------------------------------------------*/
/* mmap as "buffer" layer */
Mmap_t mptr; /* Mapped address */
Size_t len; /* mapped length */
STDCHAR *bbuf; /* malloced buffer if map fails */
-
} PerlIOMmap;
static size_t page_size = 0;
SV *sv = newSVpvn("",0);
char *s;
STRLEN len;
+#ifdef NEED_VA_COPY
+ va_list apc;
+ Perl_va_copy(ap, apc);
+ sv_vcatpvf(sv, fmt, &apc);
+#else
sv_vcatpvf(sv, fmt, &ap);
+#endif
s = SvPV(sv,len);
return PerlIO_write(f,s,len);
}
PerlIO *
PerlIO_tmpfile(void)
{
- dTHX;
/* I have no idea how portable mkstemp() is ... */
+#if defined(WIN32) || !defined(HAVE_MKSTEMP)
+ PerlIO *f = NULL;
+ FILE *stdio = tmpfile();
+ if (stdio)
+ {
+ PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,"w+"),PerlIOStdio);
+ s->stdio = stdio;
+ }
+ return f;
+#else
+ dTHX;
SV *sv = newSVpv("/tmp/PerlIO_XXXXXX",0);
int fd = mkstemp(SvPVX(sv));
PerlIO *f = NULL;
SvREFCNT_dec(sv);
}
return f;
+#endif
}
#undef HAS_FSETPOS
projects / p5sagit/p5-mst-13.2.git / blobdiff