/*
- * perlio.c Copyright (c) 1996-2001, Nick Ing-Simmons You may distribute
+ * perlio.c Copyright (c) 1996-2001, 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.
+ * Artistic License, as specified in the README file.
*/
/*
- * If we have ActivePerl-like PERL_IMPLICIT_SYS then we need a dTHX to get
+ * 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.
- * Invent a dSYS macro to abstract this out
+ * Invent a dSYS macro to abstract this out
*/
#ifdef PERL_IMPLICIT_SYS
#define dSYS dTHX
#define PERLIO_NOT_STDIO 0
#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
/*
- * #define PerlIO FILE
+ * #define PerlIO FILE
*/
#endif
/*
perlsio_binmode(FILE *fp, int iotype, int mode)
{
/*
- * This used to be contents of do_binmode in doio.c
+ * This used to be contents of do_binmode in doio.c
*/
#ifdef DOSISH
# if defined(atarist) || defined(__MINT__)
#endif
# if defined(WIN32) && defined(__BORLANDC__)
/*
- * The translation mode of the stream is maintained independent of
+ * 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
+ * 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
+ * this anywhere). GSAR 97-5-24
*/
fseek(fp, 0L, 0);
if (mode & O_BINARY)
}
Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl", names);
/*
- * NOTREACHED
+ * NOTREACHED
*/
return -1;
}
}
/*
- * De-mux PerlIO_openn() into fdopen, freopen and fopen type entries
+ * De-mux PerlIO_openn() into fdopen, freopen and fopen type entries
*/
PerlIO *
{
/*
* Does nothing (yet) except force this file to be included in perl
- * binary. That allows this file to force inclusion of other functions
+ * binary. That allows this file to force inclusion of other functions
* that may be required by loadable extensions e.g. for
- * FileHandle::tmpfile
+ * FileHandle::tmpfile
*/
}
/*
* This section is just to make sure these functions get pulled in from
- * libsfio.a
+ * libsfio.a
*/
#undef PerlIO_tmpfile
/*
* Force this file to be included in perl binary. Which allows this
* file to force inclusion of other functions that may be required by
- * loadable extensions e.g. for FileHandle::tmpfile
+ * loadable extensions e.g. for FileHandle::tmpfile
*/
/*
- * Hack sfio does its own 'autoflush' on stdout in common cases. Flush
+ * Hack sfio does its own 'autoflush' on stdout in common cases. Flush
* results in a lot of lseek()s to regular files and lot of small
- * writes to pipes.
+ * writes to pipes.
*/
sfset(sfstdout, SF_SHARE, 0);
}
#else /* USE_SFIO */
/*======================================================================================*/
/*
- * Implement all the PerlIO interface ourselves.
+ * Implement all the PerlIO interface ourselves.
*/
#include "perliol.h"
/*
* We _MUST_ have <unistd.h> if we are using lseek() and may have large
- * files
+ * files
*/
#ifdef I_UNISTD
#include <unistd.h>
/*--------------------------------------------------------------------------------------*/
/*
- * Inner level routines
+ * Inner level routines
*/
/*
- * Table of pointers to the PerlIO structs (malloc'ed)
+ * Table of pointers to the PerlIO structs (malloc'ed)
*/
PerlIO *_perlio = NULL;
#define PERLIO_TABLE_SIZE 64
PerlIO_allocate(pTHX)
{
/*
- * Find a free slot in the table, allocating new table as necessary
+ * Find a free slot in the table, allocating new table as necessary
*/
PerlIO **last;
PerlIO *f;
/*
* If popped returns non-zero do not free its layer structure
* it has either done so itself, or it is shared and still in
- * use
+ * use
*/
if ((*l->tab->Popped) (f) != 0)
return;
/*--------------------------------------------------------------------------------------*/
/*
- * XS Interface for perl code
+ * XS Interface for perl code
*/
PerlIO_funcs *
SV *layer = newSVpvn(name, len);
ENTER;
/*
- * The two SVs are magically freed by load_module
+ * The two SVs are magically freed by load_module
*/
Perl_load_module(aTHX_ 0, pkgsv, Nullsv, layer, Nullsv);
LEAVE;
/*
* Message is consistent with how attribute lists are
* passed. Even though this means "foo : : bar" is
- * seen as an invalid separator character.
+ * seen as an invalid separator character.
*/
char q = ((*s == '\'') ? '"' : '\'');
Perl_warn(aTHX_
/*
* It's a nul terminated string, not allowed
* to \ the terminating null. Anything other
- * character is passed over.
+ * character is passed over.
*/
if (*e++) {
break;
}
/*
- * Drop through
+ * Drop through
*/
case '\0':
e--;
return -1;
default:
/*
- * boring.
+ * boring.
*/
break;
}
PerlIORaw_pushed(PerlIO *f, const char *mode, SV *arg)
{
/*
- * Remove the dummy layer
+ * Remove the dummy layer
*/
dTHX;
PerlIO_pop(aTHX_ f);
/*
- * Pop back to bottom layer
+ * Pop back to bottom layer
*/
if (f && *f) {
PerlIO_flush(f);
}
else {
/*
- * Nothing bellow - push unix on top then remove it
+ * Nothing bellow - push unix on top then remove it
*/
if (PerlIO_push(aTHX_ f, PerlIO_default_btm(), mode, arg)) {
PerlIO_pop(aTHX_ PerlIONext(f));
/*--------------------------------------------------------------------------------------*/
/*
- * Given the abstraction above the public API functions
+ * Given the abstraction above the public API functions
*/
int
{
const char *type = NULL;
/*
- * Need to supply default layer info from open.pm
+ * Need to supply default layer info from open.pm
*/
if (PL_curcop) {
SV *layers = PL_curcop->cop_io;
type = SvPV(layers, len);
if (type && mode[0] != 'r') {
/*
- * Skip to write part
+ * Skip to write part
*/
const char *s = strchr(type, 0);
if (s && (s - type) < len) {
PerlIO_layer_from_ref(pTHX_ SV *sv)
{
/*
- * For any scalar type load the handler which is bundled with perl
+ * For any scalar type load the handler which is bundled with perl
*/
if (SvTYPE(sv) < SVt_PVAV)
return PerlIO_find_layer(aTHX_ "Scalar", 6, 1);
/*
- * For other types allow if layer is known but don't try and load it
+ * For other types allow if layer is known but don't try and load it
*/
switch (SvTYPE(sv)) {
case SVt_PVAV:
if (narg) {
SV *arg = *args;
/*
- * If it is a reference but not an object see if we have a handler
- * for it
+ * If it is a reference but not an object see if we have a handler
+ * for it
*/
if (SvROK(arg) && !sv_isobject(arg)) {
PerlIO_funcs *handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg));
incdef = 0;
}
/*
- * Don't fail if handler cannot be found :Via(...) etc. may do
+ * Don't fail if handler cannot be found :Via(...) etc. may do
* something sensible else we will just stringfy and open
- * resulting string.
+ * resulting string.
*/
}
}
PerlIO_funcs *tab = NULL;
if (f && *f) {
/*
- * This is "reopen" - it is not tested as perl does not use it
- * yet
+ * This is "reopen" - it is not tested as perl does not use it
+ * yet
*/
PerlIOl *l = *f;
layera = PerlIO_list_alloc();
layera = PerlIO_resolve_layers(aTHX_ layers, mode, narg, args);
}
/*
- * Start at "top" of layer stack
+ * Start at "top" of layer stack
*/
n = layera->cur - 1;
while (n >= 0) {
}
if (tab) {
/*
- * Found that layer 'n' can do opens - call it
+ * Found that layer 'n' can do opens - call it
*/
PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
tab->name, layers, mode, fd, imode, perm, f, narg,
if (n + 1 < layera->cur) {
/*
* More layers above the one that we used to open -
- * apply them now
+ * apply them now
*/
if (PerlIO_apply_layera(aTHX_ f, mode, layera, n + 1)
!= 0) {
* errorneous input? Maybe some magical value (PerlIO*
* PERLIO_FLUSH_ALL = (PerlIO*)-1;)? Yes, stdio does similar
* things on fflush(NULL), but should we be bound by their design
- * decisions? --jhi
+ * decisions? --jhi
*/
PerlIO **table = &_perlio;
int code = 0;
/*--------------------------------------------------------------------------------------*/
/*
- * utf8 and raw dummy layers
+ * utf8 and raw dummy layers
*/
IV
/*--------------------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------------------*/
/*
- * "Methods" of the "base class"
+ * "Methods" of the "base class"
*/
IV
{
dTHX;
/*
- * Save the position as current head considers it
+ * Save the position as current head considers it
*/
Off_t old = PerlIO_tell(f);
SSize_t done;
/*--------------------------------------------------------------------------------------*/
/*
- * Bottom-most level for UNIX-like case
+ * Bottom-most level for UNIX-like case
*/
typedef struct {
mode++;
}
/*
- * Always open in binary mode
+ * Always open in binary mode
*/
oflags |= O_BINARY;
if (*mode || oflags == -1) {
PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
s->fd = PerlIO_fileno(PerlIONext(f));
/*
- * XXX could (or should) we retrieve the oflags from the open file
+ * XXX could (or should) we retrieve the oflags from the open file
* handle rather than believing the "mode" we are passed in? XXX
- * Should the value on NULL mode be 0 or -1?
+ * Should the value on NULL mode be 0 or -1?
*/
s->oflags = mode ? PerlIOUnix_oflags(mode) : -1;
}
else {
if (f) {
/*
- * FIXME: pop layers ???
+ * FIXME: pop layers ???
*/
}
return NULL;
}
}
+PerlIO *
+PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+{
+ PerlIO_funcs *self = PerlIOBase(o)->tab;
+ SV *arg = Nullsv;
+ char buf[8];
+ if (self->Getarg) {
+ arg = (*self->Getarg)(o);
+#ifdef sv_dup
+ if (arg) {
+ arg = sv_dup(arg, param);
+ }
+#endif
+ }
+ if (!f) {
+ f = PerlIO_allocate(aTHX);
+ }
+ f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
+ return f;
+}
+
+PerlIO *
+PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+{
+ PerlIOUnix *os = PerlIOSelf(o, PerlIOUnix);
+ int fd = PerlLIO_dup(os->fd);
+ if (fd >= 0) {
+ f = PerlIOBase_dup(aTHX_ f, o, param);
+ if (f) {
+ /* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */
+ PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
+ s->fd = fd;
+ return f;
+ }
+ else {
+ PerlLIO_close(fd);
+ }
+ }
+ return NULL;
+}
+
+
SSize_t
PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count)
{
return PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, 0, SEEK_CUR);
}
+
IV
PerlIOUnix_close(PerlIO *f)
{
PerlIOUnix_open,
NULL,
PerlIOUnix_fileno,
+ PerlIOUnix_dup,
PerlIOUnix_read,
PerlIOBase_unread,
PerlIOUnix_write,
/*--------------------------------------------------------------------------------------*/
/*
- * stdio as a layer
+ * stdio as a layer
*/
typedef struct {
}
/*
- * This isn't used yet ...
+ * This isn't used yet ...
*/
IV
PerlIOStdio_pushed(PerlIO *f, const char *mode, SV *arg)
STDCHAR *buf = (STDCHAR *) vbuf;
/*
* Perl is expecting PerlIO_getc() to fill the buffer Linux's
- * stdio does not do that for fread()
+ * stdio does not do that for fread()
*/
int ch = PerlSIO_fgetc(s);
if (ch != EOF) {
#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
+ * 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
+ * layer read-to-read
*/
/*
- * Not writeable - sync by attempting a seek
+ * Not writeable - sync by attempting a seek
*/
int err = errno;
if (PerlSIO_fseek(stdio, (Off_t) 0, SEEK_CUR) != 0)
FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
int c;
/*
- * fflush()ing read-only streams can cause trouble on some stdio-s
+ * fflush()ing read-only streams can cause trouble on some stdio-s
*/
if ((PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) {
if (PerlSIO_fflush(stdio) != 0)
#endif
#if (!defined(STDIO_PTR_LVAL_NOCHANGE_CNT))
/*
- * Setting ptr _does_ change cnt - we are done
+ * Setting ptr _does_ change cnt - we are done
*/
return;
#endif
#endif /* STDIO_PTR_LVALUE */
}
/*
- * Now (or only) set cnt
+ * Now (or only) set cnt
*/
#ifdef STDIO_CNT_LVALUE
PerlSIO_set_cnt(stdio, cnt);
#endif
+PerlIO *
+PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+{
+ return NULL;
+}
+
PerlIO_funcs PerlIO_stdio = {
"stdio",
sizeof(PerlIOStdio),
PerlIOStdio_open,
NULL,
PerlIOStdio_fileno,
+ PerlIOStdio_dup,
PerlIOStdio_read,
PerlIOStdio_unread,
PerlIOStdio_write,
/*--------------------------------------------------------------------------------------*/
/*
- * perlio buffer layer
+ * perlio buffer layer
*/
IV
if (*mode == 'I') {
init = 1;
/*
- * mode++;
+ * mode++;
*/
}
f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
fd = PerlIO_fileno(f);
#if O_BINARY != O_TEXT
/*
- * do something about failing setmode()? --jhi
+ * do something about failing setmode()? --jhi
*/
PerlLIO_setmode(fd, O_BINARY);
#endif
if (init && fd == 2) {
/*
- * Initial stderr is unbuffered
+ * Initial stderr is unbuffered
*/
PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
}
/*
* This "flush" is akin to sfio's sync in that it handles files in either
- * read or write state
+ * read or write state
*/
IV
PerlIOBuf_flush(PerlIO *f)
int code = 0;
if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) {
/*
- * write() the buffer
+ * write() the buffer
*/
STDCHAR *buf = b->buf;
STDCHAR *p = buf;
else if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
STDCHAR *buf = PerlIO_get_base(f);
/*
- * Note position change
+ * Note position change
*/
b->posn += (b->ptr - buf);
if (b->ptr < b->end) {
/*
- * We did not consume all of it
+ * We did not consume all of it
*/
if (PerlIO_seek(PerlIONext(f), b->posn, SEEK_SET) == 0) {
b->posn = PerlIO_tell(PerlIONext(f));
b->ptr = b->end = b->buf;
PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
/*
- * FIXME: Is this right for read case ?
+ * FIXME: Is this right for read case ?
*/
if (PerlIO_flush(PerlIONext(f)) != 0)
code = -1;
* 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 (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { }
*/
if (PerlIO_flush(f) != 0)
return -1;
* 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_.
+ * hand, or ask it to fill _once_.
*/
avail = PerlIO_get_cnt(n);
if (avail <= 0) {
if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
/*
* Buffer is already a read buffer, we can overwrite any chars
- * which have been read back to buffer start
+ * which have been read back to buffer start
*/
avail = (b->ptr - b->buf);
}
else {
/*
* Buffer is idle, set it up so whole buffer is available for
- * unread
+ * unread
*/
avail = b->bufsiz;
b->end = b->buf + avail;
b->ptr = b->end;
PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
/*
- * Buffer extends _back_ from where we are now
+ * Buffer extends _back_ from where we are now
*/
b->posn -= b->bufsiz;
}
if (avail > (SSize_t) count) {
/*
- * If we have space for more than count, just move count
+ * If we have space for more than count, just move count
*/
avail = count;
}
buf -= avail;
/*
* In simple stdio-like ungetc() case chars will be already
- * there
+ * there
*/
if (buf != b->ptr) {
Copy(buf, b->ptr, avail, STDCHAR);
{
PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
/*
- * b->posn is file position where b->buf was read, or will be written
+ * b->posn is file position where b->buf was read, or will be written
*/
Off_t posn = b->posn;
if (b->buf) {
/*
- * If buffer is valid adjust position by amount in buffer
+ * If buffer is valid adjust position by amount in buffer
*/
posn += (b->ptr - b->buf);
}
PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
}
+PerlIO *
+PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+{
+ return NULL;
+}
+
+
+
PerlIO_funcs PerlIO_perlio = {
"perlio",
sizeof(PerlIOBuf),
PerlIOBuf_open,
NULL,
PerlIOBase_fileno,
+ PerlIOBuf_dup,
PerlIOBuf_read,
PerlIOBuf_unread,
PerlIOBuf_write,
/*--------------------------------------------------------------------------------------*/
/*
- * Temp layer to hold unread chars when cannot do it any other way
+ * Temp layer to hold unread chars when cannot do it any other way
*/
IV
PerlIOPending_fill(PerlIO *f)
{
/*
- * Should never happen
+ * Should never happen
*/
PerlIO_flush(f);
return 0;
PerlIOPending_close(PerlIO *f)
{
/*
- * A tad tricky - flush pops us, then we close new top
+ * A tad tricky - flush pops us, then we close new top
*/
PerlIO_flush(f);
return PerlIO_close(f);
PerlIOPending_seek(PerlIO *f, Off_t offset, int whence)
{
/*
- * A tad tricky - flush pops us, then we seek new top
+ * A tad tricky - flush pops us, then we seek new top
*/
PerlIO_flush(f);
return PerlIO_seek(f, offset, whence);
IV code = PerlIOBase_pushed(f, mode, arg);
PerlIOl *l = PerlIOBase(f);
/*
- * Our PerlIO_fast_gets must match what we are pushed on, or sv_gets()
- * etc. get muddled when it changes mid-string when we auto-pop.
+ * Our PerlIO_fast_gets must match what we are pushed on, or sv_gets()
+ * etc. get muddled when it changes mid-string when we auto-pop.
*/
l->flags = (l->flags & ~(PERLIO_F_FASTGETS | PERLIO_F_UTF8)) |
(PerlIOBase(PerlIONext(f))->
NULL,
NULL,
PerlIOBase_fileno,
+ PerlIOBuf_dup,
PerlIOPending_read,
PerlIOBuf_unread,
PerlIOBuf_write,
/*
* 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
+ * 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
+ STDCHAR *nl; /* Position of crlf we "lied" about in the
* buffer */
} PerlIOCrlf;
}
else {
/*
- * Not CR,LF but just CR
+ * Not CR,LF but just CR
*/
nl++;
goto scan;
}
else {
/*
- * Blast - found CR as last char in buffer
+ * Blast - found CR as last char in buffer
*/
if (b->ptr < nl) {
/*
* They may not care, defer work as long as
- * possible
+ * possible
*/
return (nl - b->ptr);
}
if (code == 0)
goto test; /* fill() call worked */
/*
- * CR at EOF - just fall through
+ * CR at EOF - just fall through
*/
}
}
}
else {
/*
- * Test code - delete when it works ...
+ * Test code - delete when it works ...
*/
STDCHAR *chk;
if (c->nl)
if (c->nl) {
if (ptr > c->nl) {
/*
- * They have taken what we lied about
+ * They have taken what we lied about
*/
*(c->nl) = 0xd;
c->nl = NULL;
if (*buf == '\n') {
if ((b->ptr + 2) > eptr) {
/*
- * Not room for both
+ * Not room for both
*/
PerlIO_flush(f);
break;
PerlIOBuf_open,
NULL,
PerlIOBase_fileno,
+ PerlIOBuf_dup,
PerlIOBuf_read, /* generic read works with ptr/cnt lies
* ... */
PerlIOCrlf_unread, /* Put CR,LF in buffer for each '\n' */
#ifdef HAS_MMAP
/*--------------------------------------------------------------------------------------*/
/*
- * mmap as "buffer" layer
+ * mmap as "buffer" layer
*/
typedef struct {
if (b->posn < 0) {
/*
* This is a hack - should never happen - open should
- * have set it !
+ * have set it !
*/
b->posn = PerlIO_tell(PerlIONext(f));
}
PerlIOBuf *b = &m->base;
if (b->buf && (PerlIOBase(f)->flags & PERLIO_F_RDBUF)) {
/*
- * Already have a readbuffer in progress
+ * Already have a readbuffer in progress
*/
return b->buf;
}
if (b->buf) {
/*
- * We have a write buffer or flushed PerlIOBuf read buffer
+ * We have a write buffer or flushed PerlIOBuf read buffer
*/
m->bbuf = b->buf; /* save it in case we need it again */
b->buf = NULL; /* Clear to trigger below */
PerlIOMmap_map(f); /* Try and map it */
if (!b->buf) {
/*
- * Map did not work - recover PerlIOBuf buffer if we have one
+ * Map did not work - recover PerlIOBuf buffer if we have one
*/
b->buf = m->bbuf;
}
}
if (m->len) {
/*
- * Loose the unwritable mapped buffer
+ * Loose the unwritable mapped buffer
*/
PerlIO_flush(f);
/*
- * If flush took the "buffer" see if we have one from before
+ * If flush took the "buffer" see if we have one from before
*/
if (!b->buf && m->bbuf)
b->buf = m->bbuf;
PerlIOBuf *b = &m->base;
if (!b->buf || !(PerlIOBase(f)->flags & PERLIO_F_WRBUF)) {
/*
- * No, or wrong sort of, buffer
+ * No, or wrong sort of, buffer
*/
if (m->len) {
if (PerlIOMmap_unmap(f) != 0)
return 0;
}
/*
- * If unmap took the "buffer" see if we have one from before
+ * If unmap took the "buffer" see if we have one from before
*/
if (!b->buf && m->bbuf)
b->buf = m->bbuf;
PerlIOBuf *b = &m->base;
IV code = PerlIOBuf_flush(f);
/*
- * Now we are "synced" at PerlIOBuf level
+ * Now we are "synced" at PerlIOBuf level
*/
if (b->buf) {
if (m->len) {
/*
- * Unmap the buffer
+ * Unmap the buffer
*/
if (PerlIOMmap_unmap(f) != 0)
code = -1;
else {
/*
* We seem to have a PerlIOBuf buffer which was not mapped
- * remember it in case we need one later
+ * remember it in case we need one later
*/
m->bbuf = b->buf;
}
return code;
}
+PerlIO *
+PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+{
+ return NULL;
+}
+
PerlIO_funcs PerlIO_mmap = {
"mmap",
PerlIOBuf_open,
NULL,
PerlIOBase_fileno,
+ PerlIOMmap_dup,
PerlIOBuf_read,
PerlIOMmap_unread,
PerlIOMmap_write,
/*--------------------------------------------------------------------------------------*/
/*
* Functions which can be called on any kind of PerlIO implemented in
- * terms of above
+ * terms of above
*/
#undef PerlIO_getc
PerlIO_tmpfile(void)
{
/*
- * I have no idea how portable mkstemp() is ...
+ * I have no idea how portable mkstemp() is ...
*/
#if defined(WIN32) || !defined(HAVE_MKSTEMP)
dTHX;
/*======================================================================================*/
/*
- * Now some functions in terms of above which may be needed even if we are
- * not in true PerlIO mode
+ * Now some functions in terms of above which may be needed even if we are
+ * not in true PerlIO mode
*/
#ifndef HAS_FSETPOS
projects / p5sagit/p5-mst-13.2.git / commitdiff