From: Nick Ing-Simmons Date: Fri, 3 Nov 2000 22:19:10 +0000 (+0000) Subject: Implement stack of layers - (perlio.c _is_ derived from the old file honest...) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9e353e3b7330a59ca210e75e4484e7762fcd1ce4;p=p5sagit%2Fp5-mst-13.2.git Implement stack of layers - (perlio.c _is_ derived from the old file honest...) - Works on Linux with perlio + unix stdio - Works on Solaris with perlio + unix - Fails ONE test (print to STDIN should fail) on Solaris with stdio. - Fails (hangs in openpid) if you try and stack perlio + stdio - Linux stdio's read() logic is hanging. p4raw-id: //depot/perlio@7535 --- diff --git a/iperlsys.h b/iperlsys.h index caca9df..94e5fd6 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -81,7 +81,9 @@ typedef Signal_t (*Sighandler_t) (int); #if defined(PERL_IMPLICIT_SYS) #ifndef PerlIO -typedef struct _PerlIO PerlIO; +typedef struct _PerlIO PerlIOl; +typedef PerlIOl *PerlIO; +#define PerlIO PerlIO #endif /* IPerlStdIO */ @@ -331,7 +333,8 @@ struct IPerlStdIOInfo #endif #ifndef PerlIO -typedef struct _PerlIO PerlIO; +typedef struct _PerlIO PerlIOl; +typedef PerlIOl *PerlIO; #define PerlIO PerlIO #endif /* No PerlIO */ diff --git a/perlio.c b/perlio.c index 4ed8f03..3a1906d 100644 --- a/perlio.c +++ b/perlio.c @@ -84,11 +84,9 @@ PerlIO_init(void) } #else /* USE_SFIO */ - /*======================================================================================*/ - /* Implement all the PerlIO interface ourselves. -*/ + */ /* We _MUST_ have if we are using lseek() and may have large files */ #ifdef I_UNISTD @@ -126,152 +124,73 @@ PerlIO_debug(char *fmt,...) } } -#define PERLIO_F_EOF 0x010000 -#define PERLIO_F_ERROR 0x020000 -#define PERLIO_F_LINEBUF 0x040000 -#define PERLIO_F_TEMP 0x080000 -#define PERLIO_F_RDBUF 0x100000 -#define PERLIO_F_WRBUF 0x200000 -#define PERLIO_F_OPEN 0x400000 -#define PERLIO_F_USED 0x800000 +/*--------------------------------------------------------------------------------------*/ + +typedef struct +{ + char * name; + Size_t size; + IV kind; + IV (*Fileno)(PerlIO *f); + PerlIO * (*Fdopen)(int fd, const char *mode); + PerlIO * (*Open)(const char *path, const char *mode); + int (*Reopen)(const char *path, const char *mode, PerlIO *f); + /* Unix-like functions - cf sfio line disciplines */ + SSize_t (*Read)(PerlIO *f, void *vbuf, Size_t count); + SSize_t (*Unread)(PerlIO *f, const void *vbuf, Size_t count); + SSize_t (*Write)(PerlIO *f, const void *vbuf, Size_t count); + IV (*Seek)(PerlIO *f, Off_t offset, int whence); + Off_t (*Tell)(PerlIO *f); + IV (*Close)(PerlIO *f); + /* Stdio-like buffered IO functions */ + IV (*Flush)(PerlIO *f); + IV (*Eof)(PerlIO *f); + IV (*Error)(PerlIO *f); + void (*Clearerr)(PerlIO *f); + void (*Setlinebuf)(PerlIO *f); + /* Perl's snooping functions */ + STDCHAR * (*Get_base)(PerlIO *f); + Size_t (*Get_bufsiz)(PerlIO *f); + STDCHAR * (*Get_ptr)(PerlIO *f); + SSize_t (*Get_cnt)(PerlIO *f); + void (*Set_ptrcnt)(PerlIO *f,STDCHAR *ptr,SSize_t cnt); +} PerlIO_funcs; + struct _PerlIO { - IV flags; /* Various flags for state */ - IV fd; /* Maybe pointer on some OSes */ - int oflags; /* open/fcntl flags */ - STDCHAR *buf; /* Start of buffer */ - STDCHAR *end; /* End of valid part of buffer */ - STDCHAR *ptr; /* Current position in buffer */ - Size_t bufsiz; /* Size of buffer */ - Off_t posn; /* Offset of f->buf into the file */ - int oneword; /* An if-all-else-fails area as a buffer */ + PerlIOl * next; /* Lower layer */ + PerlIO_funcs * tab; /* Functions for this layer */ + IV flags; /* Various flags for state */ }; +/*--------------------------------------------------------------------------------------*/ + +/* Flag values */ +#define PERLIO_F_EOF 0x0010000 +#define PERLIO_F_CANWRITE 0x0020000 +#define PERLIO_F_CANREAD 0x0040000 +#define PERLIO_F_ERROR 0x0080000 +#define PERLIO_F_TRUNCATE 0x0100000 +#define PERLIO_F_APPEND 0x0200000 +#define PERLIO_F_BINARY 0x0400000 +#define PERLIO_F_TEMP 0x0800000 +#define PERLIO_F_LINEBUF 0x0100000 +#define PERLIO_F_WRBUF 0x2000000 +#define PERLIO_F_RDBUF 0x4000000 +#define PERLIO_F_OPEN 0x8000000 + +#define PerlIOBase(f) (*(f)) +#define PerlIOSelf(f,type) ((type *)PerlIOBase(f)) +#define PerlIONext(f) (&(PerlIOBase(f)->next)) + +/*--------------------------------------------------------------------------------------*/ +/* Inner level routines */ + /* Table of pointers to the PerlIO structs (malloc'ed) */ PerlIO **_perlio = NULL; int _perlio_size = 0; -void -PerlIO_alloc_buf(PerlIO *f) -{ - if (!f->bufsiz) - f->bufsiz = 4096; - New('B',f->buf,f->bufsiz,char); - if (!f->buf) - { - f->buf = (STDCHAR *)&f->oneword; - f->bufsiz = sizeof(f->oneword); - } - f->ptr = f->buf; - f->end = f->ptr; -} - - -/* This "flush" is akin to sfio's sync in that it handles files in either - read or write state -*/ -#undef PerlIO_flush -int -PerlIO_flush(PerlIO *f) -{ - int code = 0; - if (f) - { - if (f->flags & PERLIO_F_WRBUF) - { - /* write() the buffer */ - STDCHAR *p = f->buf; - int count; - while (p < f->ptr) - { - count = write(f->fd,p,f->ptr - p); - if (count > 0) - { - p += count; - } - else if (count < 0 && errno != EINTR) - { - f->flags |= PERLIO_F_ERROR; - code = -1; - break; - } - } - f->posn += (p - f->buf); - } - else if (f->flags & PERLIO_F_RDBUF) - { - /* Note position change */ - f->posn += (f->ptr - f->buf); - if (f->ptr < f->end) - { - /* We did not consume all of it */ - f->posn = lseek(f->fd,f->posn,SEEK_SET); - } - } - f->ptr = f->end = f->buf; - f->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF); - } - else - { - int i; - for (i=_perlio_size-1; i >= 0; i--) - { - if ((f = _perlio[i])) - { - if (PerlIO_flush(f) != 0) - code = -1; - } - } - } - return code; -} - -int -PerlIO_oflags(const char *mode) -{ - int oflags = -1; - switch(*mode) - { - case 'r': - oflags = O_RDONLY; - if (*++mode == '+') - { - oflags = O_RDWR; - mode++; - } - break; - - case 'w': - oflags = O_CREAT|O_TRUNC; - if (*++mode == '+') - { - oflags |= O_RDWR; - mode++; - } - else - oflags |= O_WRONLY; - break; - - case 'a': - oflags = O_CREAT|O_APPEND; - if (*++mode == '+') - { - oflags |= O_RDWR; - mode++; - } - else - oflags |= O_WRONLY; - break; - } - if (*mode || oflags == -1) - { - errno = EINVAL; - oflags = -1; - } - return oflags; -} - PerlIO * PerlIO_allocate(void) { @@ -291,10 +210,9 @@ PerlIO_allocate(void) return NULL; table[i] = f; } - if (!(f->flags & PERLIO_F_USED)) + if (!*f) { - Zero(f,1,PerlIO); - f->flags = PERLIO_F_USED; + PerlIO_debug(__FUNCTION__ " f=%p\n",f); return f; } i++; @@ -310,60 +228,25 @@ PerlIO_allocate(void) } } -#undef PerlIO_fdopen -PerlIO * -PerlIO_fdopen(int fd, const char *mode) -{ - PerlIO *f = NULL; - if (fd >= 0) - { - if ((f = PerlIO_allocate())) - { - f->fd = fd; - f->oflags = PerlIO_oflags(mode); - f->flags |= (PERLIO_F_OPEN|PERLIO_F_USED); - } - } - return f; -} - -#undef PerlIO_fileno -int -PerlIO_fileno(PerlIO *f) +void +PerlIO_pop(PerlIO *f) { - if (f && (f->flags & PERLIO_F_OPEN)) + PerlIOl *l = *f; + if (l) { - return f->fd; + *f = l->next; + Safefree(l); } - return -1; } #undef PerlIO_close int PerlIO_close(PerlIO *f) { - int code = 0; - if (f) + int code = (*PerlIOBase(f)->tab->Close)(f); + while (*f) { - if (PerlIO_flush(f) != 0) - code = -1; - while (close(f->fd) != 0) - { - if (errno != EINTR) - { - code = -1; - break; - } - } - f->flags &= ~PERLIO_F_OPEN; - f->fd = -1; - if (f->buf && f->buf != (STDCHAR *) &f->oneword) - { - Safefree(f->buf); - } - f->buf = NULL; - f->ptr = f->end = f->buf; - f->flags &= ~(PERLIO_F_USED|PERLIO_F_RDBUF|PERLIO_F_WRBUF); + PerlIO_pop(f); } return code; } @@ -378,7 +261,8 @@ PerlIO_cleanup(void) PerlIO *f = _perlio[i]; if (f) { - PerlIO_close(f); + if (*f) + PerlIO_close(f); Safefree(f); } } @@ -388,290 +272,1031 @@ PerlIO_cleanup(void) _perlio_size = 0; } + + +/*--------------------------------------------------------------------------------------*/ +/* Given the abstraction above the public API functions */ + +#undef PerlIO_fileno +int +PerlIO_fileno(PerlIO *f) +{ + return (*PerlIOBase(f)->tab->Fileno)(f); +} + +extern PerlIO_funcs PerlIO_unix; +extern PerlIO_funcs PerlIO_stdio; +extern PerlIO_funcs PerlIO_perlio; + +#define PerlIO_default_top() &PerlIO_stdio +#define PerlIO_default_btm() &PerlIO_unix + +#undef PerlIO_fdopen +PerlIO * +PerlIO_fdopen(int fd, const char *mode) +{ + PerlIO_funcs *tab = PerlIO_default_top(); + return (*tab->Fdopen)(fd,mode); +} + #undef PerlIO_open PerlIO * PerlIO_open(const char *path, const char *mode) { - PerlIO *f = NULL; - int oflags = PerlIO_oflags(mode); - if (oflags != -1) - { - int fd = open(path,oflags,0666); - if (fd >= 0) - { - f = PerlIO_fdopen(fd,mode); - if (!f) - close(fd); - } - } - return f; + PerlIO_funcs *tab = PerlIO_default_top(); + return (*tab->Open)(path,mode); } -#undef PerlIO_reopen -PerlIO * -PerlIO_reopen(const char *path, const char *mode, PerlIO *f) +IV +PerlIOBase_init(PerlIO *f, const char *mode) { - if (f) + PerlIOl *l = PerlIOBase(f); + l->flags &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE| + PERLIO_F_TRUNCATE|PERLIO_F_APPEND|PERLIO_F_BINARY); + if (mode) { - int oflags = PerlIO_oflags(mode); - PerlIO_close(f); - if (oflags != -1) + switch (*mode++) + { + case 'r': + l->flags = PERLIO_F_CANREAD; + break; + case 'a': + l->flags = PERLIO_F_APPEND|PERLIO_F_CANWRITE; + break; + case 'w': + l->flags = PERLIO_F_TRUNCATE|PERLIO_F_CANWRITE; + break; + default: + errno = EINVAL; + return -1; + } + while (*mode) { - int fd = open(path,oflags,0666); - if (fd >= 0) + switch (*mode++) { - f->oflags = oflags; - f->flags |= (PERLIO_F_OPEN|PERLIO_F_USED); + case '+': + l->flags |= PERLIO_F_CANREAD|PERLIO_F_CANWRITE; + break; + case 'b': + l->flags |= PERLIO_F_BINARY; + break; + default: + errno = EINVAL; + return -1; } } - else + } + else + { + if (l->next) { - return NULL; + l->flags |= l->next->flags & + (PERLIO_F_CANREAD|PERLIO_F_CANWRITE| + PERLIO_F_TRUNCATE|PERLIO_F_APPEND|PERLIO_F_BINARY); } } - return PerlIO_open(path,mode); + return 0; } -void -PerlIO_init(void) +#undef PerlIO_reopen +PerlIO * +PerlIO_reopen(const char *path, const char *mode, PerlIO *f) { - if (!_perlio) + if (f) { - atexit(&PerlIO_cleanup); - PerlIO_fdopen(0,"r"); - PerlIO_fdopen(1,"w"); - PerlIO_fdopen(2,"w"); + PerlIO_flush(f); + if ((*PerlIOBase(f)->tab->Reopen)(path,mode,f) == 0) + { + PerlIOBase_init(f,mode); + return f; + } + return NULL; } + else + return PerlIO_open(path,mode); } -#undef PerlIO_stdin -PerlIO * -PerlIO_stdin(void) -{ - if (!_perlio) - PerlIO_init(); - return _perlio[0]; -} - -#undef PerlIO_stdout -PerlIO * -PerlIO_stdout(void) -{ - if (!_perlio) - PerlIO_init(); - return _perlio[1]; -} - -#undef PerlIO_stderr -PerlIO * -PerlIO_stderr(void) +#undef PerlIO_read +SSize_t +PerlIO_read(PerlIO *f, void *vbuf, Size_t count) { - if (!_perlio) - PerlIO_init(); - return _perlio[2]; + return (*PerlIOBase(f)->tab->Read)(f,vbuf,count); } -#undef PerlIO_fast_gets +#undef PerlIO_ungetc int -PerlIO_fast_gets(PerlIO *f) +PerlIO_ungetc(PerlIO *f, int ch) { - return 1; + STDCHAR buf = ch; + if ((*PerlIOBase(f)->tab->Unread)(f,&buf,1) == 1) + return ch; + return -1; } -#undef PerlIO_has_cntptr -int -PerlIO_has_cntptr(PerlIO *f) +#undef PerlIO_write +SSize_t +PerlIO_write(PerlIO *f, const void *vbuf, Size_t count) { - return 1; + return (*PerlIOBase(f)->tab->Write)(f,vbuf,count); } -#undef PerlIO_canset_cnt +#undef PerlIO_seek int -PerlIO_canset_cnt(PerlIO *f) +PerlIO_seek(PerlIO *f, Off_t offset, int whence) { - return 1; + return (*PerlIOBase(f)->tab->Seek)(f,offset,whence); } -#undef PerlIO_set_cnt -void -PerlIO_set_cnt(PerlIO *f, int cnt) +#undef PerlIO_tell +Off_t +PerlIO_tell(PerlIO *f) { - if (f) - { - dTHX; - if (!f->buf) - PerlIO_alloc_buf(f); - f->ptr = f->end - cnt; - assert(f->ptr >= f->buf); - } + return (*PerlIOBase(f)->tab->Tell)(f); } -#undef PerlIO_get_cnt +#undef PerlIO_flush int -PerlIO_get_cnt(PerlIO *f) +PerlIO_flush(PerlIO *f) { if (f) { - if (!f->buf) - PerlIO_alloc_buf(f); - if (f->flags & PERLIO_F_RDBUF) - return (f->end - f->ptr); + return (*PerlIOBase(f)->tab->Flush)(f); } - return 0; -} - -#undef PerlIO_set_ptrcnt -void -PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt) -{ - if (f) + else { - if (!f->buf) - PerlIO_alloc_buf(f); - f->ptr = ptr; - if (PerlIO_get_cnt(f) != cnt || f->ptr < f->buf) + int code = 0; + int i; + for (i=_perlio_size-1; i >= 0; i--) { - dTHX; - assert(PerlIO_get_cnt(f) == cnt); - assert(f->ptr >= f->buf); + if ((f = _perlio[i])) + { + if (*f && PerlIO_flush(f) != 0) + code = -1; + } } - f->flags |= PERLIO_F_RDBUF; + return code; } } -#undef PerlIO_get_bufsiz +#undef PerlIO_eof int -PerlIO_get_bufsiz(PerlIO *f) +PerlIO_eof(PerlIO *f) { - if (f) + return (*PerlIOBase(f)->tab->Eof)(f); +} + +#undef PerlIO_error +int +PerlIO_error(PerlIO *f) +{ + return (*PerlIOBase(f)->tab->Error)(f); +} + +#undef PerlIO_clearerr +void +PerlIO_clearerr(PerlIO *f) +{ + (*PerlIOBase(f)->tab->Clearerr)(f); +} + +#undef PerlIO_setlinebuf +void +PerlIO_setlinebuf(PerlIO *f) +{ + (*PerlIOBase(f)->tab->Setlinebuf)(f); +} + +#undef PerlIO_has_base +int +PerlIO_has_base(PerlIO *f) +{ + if (f && *f) { - if (!f->buf) - PerlIO_alloc_buf(f); - return f->bufsiz; + return (PerlIOBase(f)->tab->Get_base != NULL); } - return -1; + return 0; } -#undef PerlIO_get_ptr -STDCHAR * -PerlIO_get_ptr(PerlIO *f) +#undef PerlIO_fast_gets +int +PerlIO_fast_gets(PerlIO *f) { - if (f) + if (f && *f) { - if (!f->buf) - PerlIO_alloc_buf(f); - return f->ptr; + return (PerlIOBase(f)->tab->Set_ptrcnt != NULL); } - return NULL; + return 0; +} + +#undef PerlIO_has_cntptr +int +PerlIO_has_cntptr(PerlIO *f) +{ + if (f && *f) + { + PerlIO_funcs *tab = PerlIOBase(f)->tab; + return (tab->Get_ptr != NULL && tab->Get_cnt != NULL); + } + return 0; +} + +#undef PerlIO_canset_cnt +int +PerlIO_canset_cnt(PerlIO *f) +{ + if (f && *f) + { + return (PerlIOBase(f)->tab->Set_ptrcnt != NULL); + } + return 1; } #undef PerlIO_get_base STDCHAR * PerlIO_get_base(PerlIO *f) { - if (f) + return (*PerlIOBase(f)->tab->Get_base)(f); +} + +#undef PerlIO_get_bufsiz +int +PerlIO_get_bufsiz(PerlIO *f) +{ + return (*PerlIOBase(f)->tab->Get_bufsiz)(f); +} + +#undef PerlIO_get_ptr +STDCHAR * +PerlIO_get_ptr(PerlIO *f) +{ + return (*PerlIOBase(f)->tab->Get_ptr)(f); +} + +#undef PerlIO_get_cnt +SSize_t +PerlIO_get_cnt(PerlIO *f) +{ + return (*PerlIOBase(f)->tab->Get_cnt)(f); +} + +#undef PerlIO_set_cnt +void +PerlIO_set_cnt(PerlIO *f,SSize_t cnt) +{ + return (*PerlIOBase(f)->tab->Set_ptrcnt)(f,NULL,cnt); +} + +#undef PerlIO_set_ptrcnt +void +PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt) +{ + return (*PerlIOBase(f)->tab->Set_ptrcnt)(f,ptr,cnt); +} + +/*--------------------------------------------------------------------------------------*/ +/* "Methods" of the "base class" */ + +IV +PerlIOBase_fileno(PerlIO *f) +{ + return PerlIO_fileno(PerlIONext(f)); +} + +PerlIO * +PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode) +{ + PerlIOl *l = NULL; + Newc('L',l,tab->size,char,PerlIOl); + if (l) { - if (!f->buf) - PerlIO_alloc_buf(f); - return f->buf; + Zero(l,tab->size,char); + l->next = *f; + l->tab = tab; + *f = l; + PerlIOBase_init(f,mode); + PerlIO_debug(__FUNCTION__ " f=%p %08lX %s\n",f,PerlIOBase(f)->flags,tab->name); } - return NULL; + return f; } -#undef PerlIO_has_base +SSize_t +PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count) +{ + Off_t old = PerlIO_tell(f); + if (PerlIO_seek(f,-((Off_t)count),SEEK_CUR) == 0) + { + Off_t new = PerlIO_tell(f); + return old - new; + } + return 0; +} + +IV +PerlIOBase_sync(PerlIO *f) +{ + return 0; +} + +IV +PerlIOBase_close(PerlIO *f) +{ + IV code = 0; + if (PerlIO_flush(f) != 0) + code = -1; + if (PerlIO_close(PerlIONext(f)) != 0) + code = -1; + PerlIOBase(f)->flags &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE|PERLIO_F_OPEN); + return code; +} + +IV +PerlIOBase_eof(PerlIO *f) +{ + if (f && *f) + { + return (PerlIOBase(f)->flags & PERLIO_F_EOF) != 0; + } + return 1; +} + +IV +PerlIOBase_error(PerlIO *f) +{ + if (f && *f) + { + return (PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0; + } + return 1; +} + +void +PerlIOBase_clearerr(PerlIO *f) +{ + if (f && *f) + { + PerlIOBase(f)->flags &= ~PERLIO_F_ERROR; + } +} + +void +PerlIOBase_setlinebuf(PerlIO *f) +{ + +} + + + +/*--------------------------------------------------------------------------------------*/ +/* Bottom-most level for UNIX-like case */ + +typedef struct +{ + struct _PerlIO base; /* The generic part */ + int fd; /* UNIX like file descriptor */ + int oflags; /* open/fcntl flags */ +} PerlIOUnix; + int -PerlIO_has_base(PerlIO *f) +PerlIOUnix_oflags(const char *mode) { - if (f) + int oflags = -1; + switch(*mode) + { + case 'r': + oflags = O_RDONLY; + if (*++mode == '+') + { + oflags = O_RDWR; + mode++; + } + break; + + case 'w': + oflags = O_CREAT|O_TRUNC; + if (*++mode == '+') + { + oflags |= O_RDWR; + mode++; + } + else + oflags |= O_WRONLY; + break; + + case 'a': + oflags = O_CREAT|O_APPEND; + if (*++mode == '+') + { + oflags |= O_RDWR; + mode++; + } + else + oflags |= O_WRONLY; + break; + } + if (*mode || oflags == -1) { - if (!f->buf) - PerlIO_alloc_buf(f); - return f->buf != NULL; + errno = EINVAL; + oflags = -1; } + return oflags; +} + +IV +PerlIOUnix_fileno(PerlIO *f) +{ + return PerlIOSelf(f,PerlIOUnix)->fd; +} + +PerlIO * +PerlIOUnix_fdopen(int fd,const char *mode) +{ + PerlIO *f = NULL; + if (fd >= 0) + { + int oflags = PerlIOUnix_oflags(mode); + if (oflags != -1) + { + PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_unix,mode),PerlIOUnix); + s->fd = fd; + s->oflags = oflags; + PerlIOBase(f)->flags |= PERLIO_F_OPEN; + } + } + return f; +} + +PerlIO * +PerlIOUnix_open(const char *path,const char *mode) +{ + PerlIO *f = NULL; + int oflags = PerlIOUnix_oflags(mode); + if (oflags != -1) + { + int fd = open(path,oflags,0666); + if (fd >= 0) + { + PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_unix,mode),PerlIOUnix); + s->fd = fd; + s->oflags = oflags; + PerlIOBase(f)->flags |= PERLIO_F_OPEN; + } + } + return f; } -#undef PerlIO_puts int -PerlIO_puts(PerlIO *f, const char *s) +PerlIOUnix_reopen(const char *path, const char *mode, PerlIO *f) { - STRLEN len = strlen(s); - return PerlIO_write(f,s,len); + PerlIOUnix *s = PerlIOSelf(f,PerlIOUnix); + int oflags = PerlIOUnix_oflags(mode); + if (PerlIOBase(f)->flags & PERLIO_F_OPEN) + (*PerlIOBase(f)->tab->Close)(f); + if (oflags != -1) + { + int fd = open(path,oflags,0666); + if (fd >= 0) + { + s->fd = fd; + s->oflags = oflags; + PerlIOBase(f)->flags |= PERLIO_F_OPEN; + return 0; + } + } + return -1; +} + +SSize_t +PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count) +{ + int fd = PerlIOSelf(f,PerlIOUnix)->fd; + while (1) + { + SSize_t len = read(fd,vbuf,count); + if (len >= 0 || errno != EINTR) + return len; + } +} + +SSize_t +PerlIOUnix_write(PerlIO *f, const void *vbuf, Size_t count) +{ + int fd = PerlIOSelf(f,PerlIOUnix)->fd; + while (1) + { + SSize_t len = write(fd,vbuf,count); + if (len >= 0 || errno != EINTR) + return len; + } +} + +IV +PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence) +{ + Off_t new = lseek(PerlIOSelf(f,PerlIOUnix)->fd,offset,whence); + return (new == (Off_t) -1) ? -1 : 0; +} + +Off_t +PerlIOUnix_tell(PerlIO *f) +{ + return lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR); +} + +IV +PerlIOUnix_close(PerlIO *f) +{ + int fd = PerlIOSelf(f,PerlIOUnix)->fd; + int code = 0; + while (close(fd) != 0) + { + if (errno != EINTR) + { + code = -1; + break; + } + } + if (code == 0) + { + PerlIOBase(f)->flags &= ~PERLIO_F_OPEN; + } + return code; +} + +PerlIO_funcs PerlIO_unix = { + "unix", + sizeof(PerlIOUnix), + 0, + PerlIOUnix_fileno, + PerlIOUnix_fdopen, + PerlIOUnix_open, + PerlIOUnix_reopen, + PerlIOUnix_read, + PerlIOBase_unread, + PerlIOUnix_write, + PerlIOUnix_seek, + PerlIOUnix_tell, + PerlIOUnix_close, + PerlIOBase_sync, + PerlIOBase_eof, + PerlIOBase_error, + PerlIOBase_clearerr, + PerlIOBase_setlinebuf, + NULL, /* get_base */ + NULL, /* get_bufsiz */ + NULL, /* get_ptr */ + NULL, /* get_cnt */ + NULL, /* set_ptrcnt */ +}; + +/*--------------------------------------------------------------------------------------*/ +/* stdio as a layer */ + +typedef struct +{ + struct _PerlIO base; + FILE * stdio; /* The stream */ +} PerlIOStdio; + +IV +PerlIOStdio_fileno(PerlIO *f) +{ + return fileno(PerlIOSelf(f,PerlIOStdio)->stdio); +} + + +PerlIO * +PerlIOStdio_fdopen(int fd,const char *mode) +{ + PerlIO *f = NULL; + if (fd >= 0) + { + FILE *stdio = fdopen(fd,mode); + if (stdio) + { + PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,mode),PerlIOStdio); + s->stdio = stdio; + } + } + return f; +} + +#undef PerlIO_importFILE +PerlIO * +PerlIO_importFILE(FILE *stdio, int fl) +{ + PerlIO *f = NULL; + if (stdio) + { + PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,"r+"),PerlIOStdio); + s->stdio = stdio; + } + return f; +} + +PerlIO * +PerlIOStdio_open(const char *path,const char *mode) +{ + PerlIO *f = NULL; + FILE *stdio = fopen(path,mode); + if (stdio) + { + PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,mode),PerlIOStdio); + s->stdio = stdio; + } + return f; } -#undef PerlIO_eof int -PerlIO_eof(PerlIO *f) +PerlIOStdio_reopen(const char *path, const char *mode, PerlIO *f) +{ + PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio); + FILE *stdio = freopen(path,mode,s->stdio); + if (!s->stdio) + return -1; + s->stdio = stdio; + return 0; +} + +SSize_t +PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count) +{ + FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio; + if (count == 1) + { + STDCHAR *buf = (STDCHAR *) vbuf; + /* Perl is expecting PerlIO_getc() to fill the buffer + * Linux's stdio does not do that for fread() + */ + int ch = fgetc(s); + if (ch != EOF) + { + *buf = ch; + return 1; + } + return 0; + } + return fread(vbuf,1,count,s); +} + +SSize_t +PerlIOStdio_unread(PerlIO *f, const void *vbuf, Size_t count) +{ + FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio; + STDCHAR *buf = ((STDCHAR *)vbuf)+count-1; + SSize_t unread = 0; + while (count > 0) + { + int ch = *buf-- & 0xff; + if (ungetc(ch,s) != ch) + break; + unread++; + count--; + } + return unread; +} + +SSize_t +PerlIOStdio_write(PerlIO *f, const void *vbuf, Size_t count) +{ + return fwrite(vbuf,1,count,PerlIOSelf(f,PerlIOStdio)->stdio); +} + +IV +PerlIOStdio_seek(PerlIO *f, Off_t offset, int whence) +{ + return fseek(PerlIOSelf(f,PerlIOStdio)->stdio,offset,whence); +} + +Off_t +PerlIOStdio_tell(PerlIO *f) +{ + return ftell(PerlIOSelf(f,PerlIOStdio)->stdio); +} + +IV +PerlIOStdio_close(PerlIO *f) +{ + return fclose(PerlIOSelf(f,PerlIOStdio)->stdio); +} + +IV +PerlIOStdio_flush(PerlIO *f) +{ + FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio; + return fflush(stdio); +} + +IV +PerlIOStdio_eof(PerlIO *f) +{ + return feof(PerlIOSelf(f,PerlIOStdio)->stdio); +} + +IV +PerlIOStdio_error(PerlIO *f) +{ + return ferror(PerlIOSelf(f,PerlIOStdio)->stdio); +} + +void +PerlIOStdio_clearerr(PerlIO *f) +{ + clearerr(PerlIOSelf(f,PerlIOStdio)->stdio); +} + +void +PerlIOStdio_setlinebuf(PerlIO *f) +{ +#ifdef HAS_SETLINEBUF + setlinebuf(PerlIOSelf(f,PerlIOStdio)->stdio); +#else + setvbuf(PerlIOSelf(f,PerlIOStdio)->stdio, Nullch, _IOLBF, 0); +#endif +} + +#ifdef FILE_base +STDCHAR * +PerlIOStdio_get_base(PerlIO *f) +{ + FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio; + return FILE_base(stdio); +} + +Size_t +PerlIOStdio_get_bufsiz(PerlIO *f) +{ + FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio; + return FILE_bufsiz(stdio); +} +#endif + +#ifdef USE_STDIO_PTR +STDCHAR * +PerlIOStdio_get_ptr(PerlIO *f) +{ + FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio; + return FILE_ptr(stdio); +} + +SSize_t +PerlIOStdio_get_cnt(PerlIO *f) +{ + FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio; + return FILE_cnt(stdio); +} + +void +PerlIOStdio_set_ptrcnt(PerlIO *f,STDCHAR *ptr,SSize_t cnt) +{ + FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio; + if (ptr != NULL) + { +#ifdef STDIO_PTR_LVALUE + FILE_ptr(stdio) = ptr; +#ifdef STDIO_PTR_LVAL_SETS_CNT + if (FILE_cnt(stdio) != (cnt)) + { + dTHX; + assert(FILE_cnt(stdio) == (cnt)); + } +#endif +#if (!defined(STDIO_PTR_LVAL_NOCHANGE_CNT)) + /* Setting ptr _does_ change cnt - we are done */ + return; +#endif +#else /* STDIO_PTR_LVALUE */ + abort(); +#endif /* STDIO_PTR_LVALUE */ + } +/* Now (or only) set cnt */ +#ifdef STDIO_CNT_LVALUE + FILE_cnt(stdio) = cnt; +#else /* STDIO_CNT_LVALUE */ +#if (defined(STDIO_PTR_LVALUE) && defined(STDIO_PTR_LVAL_SETS_CNT)) + FILE_ptr(stdio) = FILE_ptr(stdio)+(FILE_cnt(stdio)-cnt); +#else /* STDIO_PTR_LVAL_SETS_CNT */ + abort(); +#endif /* STDIO_PTR_LVAL_SETS_CNT */ +#endif /* STDIO_CNT_LVALUE */ +} + +#endif + +PerlIO_funcs PerlIO_stdio = { + "stdio", + sizeof(PerlIOStdio), + 0, + PerlIOStdio_fileno, + PerlIOStdio_fdopen, + PerlIOStdio_open, + PerlIOStdio_reopen, + PerlIOStdio_read, + PerlIOStdio_unread, + PerlIOStdio_write, + PerlIOStdio_seek, + PerlIOStdio_tell, + PerlIOStdio_close, + PerlIOStdio_flush, + PerlIOStdio_eof, + PerlIOStdio_error, + PerlIOStdio_clearerr, + PerlIOStdio_setlinebuf, +#ifdef FILE_base + PerlIOStdio_get_base, + PerlIOStdio_get_bufsiz, +#else + NULL, + NULL, +#endif +#ifdef USE_STDIO_PTR + PerlIOStdio_get_ptr, + PerlIOStdio_get_cnt, +#if (defined(STDIO_PTR_LVALUE) && \ + (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT))) + PerlIOStdio_set_ptrcnt +#else /* STDIO_PTR_LVALUE */ + NULL +#endif /* STDIO_PTR_LVALUE */ +#else /* USE_STDIO_PTR */ + NULL, + NULL, + NULL +#endif /* USE_STDIO_PTR */ +}; + +#undef PerlIO_exportFILE +FILE * +PerlIO_exportFILE(PerlIO *f, int fl) +{ + PerlIO_flush(f); + /* Should really push stdio discipline when we have them */ + return fdopen(PerlIO_fileno(f),"r+"); +} + +#undef PerlIO_findFILE +FILE * +PerlIO_findFILE(PerlIO *f) +{ + return PerlIO_exportFILE(f,0); +} + +#undef PerlIO_releaseFILE +void +PerlIO_releaseFILE(PerlIO *p, FILE *f) +{ +} + +/*--------------------------------------------------------------------------------------*/ +/* perlio buffer layer */ + +typedef struct { + struct _PerlIO base; + Off_t posn; /* Offset of buf into the file */ + STDCHAR * buf; /* Start of buffer */ + STDCHAR * end; /* End of valid part of buffer */ + STDCHAR * ptr; /* Current position in buffer */ + Size_t bufsiz; /* Size of buffer */ + IV oneword; /* Emergency buffer */ +} PerlIOBuf; + + +PerlIO * +PerlIOBuf_fdopen(int fd, const char *mode) +{ + PerlIO_funcs *tab = PerlIO_default_btm(); + PerlIO *f = (*tab->Fdopen)(fd,mode); if (f) { - return (f->flags & PERLIO_F_EOF) != 0; + PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,&PerlIO_perlio,NULL),PerlIOBuf); + b->posn = PerlIO_tell(PerlIONext(f)); } - return 1; + return f; } -#undef PerlIO_getname -char * -PerlIO_getname(PerlIO *f, char *buf) +PerlIO * +PerlIOBuf_open(const char *path, const char *mode) { - dTHX; - Perl_croak(aTHX_ "Don't know how to get file name"); - return NULL; + PerlIO_funcs *tab = PerlIO_default_btm(); + PerlIO *f = (*tab->Open)(path,mode); + if (f) + { + PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,&PerlIO_perlio,NULL),PerlIOBuf); + b->posn = 0; + } + return f; +} + +int +PerlIOBase_reopen(const char *path, const char *mode, PerlIO *f) +{ + return (*PerlIOBase(f)->tab->Reopen)(path,mode,PerlIONext(f)); +} + +void +PerlIOBuf_alloc_buf(PerlIOBuf *b) +{ + if (!b->bufsiz) + b->bufsiz = 4096; + New('B',b->buf,b->bufsiz,char); + if (!b->buf) + { + b->buf = (STDCHAR *)&b->oneword; + b->bufsiz = sizeof(b->oneword); + } + b->ptr = b->buf; + b->end = b->ptr; } -#undef PerlIO_ungetc -int -PerlIO_ungetc(PerlIO *f, int ch) +/* This "flush" is akin to sfio's sync in that it handles files in either + read or write state +*/ +IV +PerlIOBuf_flush(PerlIO *f) { - if (f->buf && (f->flags & PERLIO_F_RDBUF) && f->ptr > f->buf) + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + int code = 0; + if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) + { + /* write() the buffer */ + STDCHAR *p = b->buf; + int count; + while (p < b->ptr) + { + count = PerlIO_write(PerlIONext(f),p,b->ptr - p); + if (count > 0) + { + p += count; + } + else if (count < 0) + { + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + code = -1; + break; + } + } + b->posn += (p - b->buf); + } + else if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) { - *--(f->ptr) = ch; - return ch; + /* Note position change */ + b->posn += (b->ptr - b->buf); + if (b->ptr < b->end) + { + /* We did not consume all of it */ + if (PerlIO_seek(PerlIONext(f),b->posn,SEEK_SET) == 0) + { + b->posn = PerlIO_tell(PerlIONext(f)); + } + } } - return -1; + b->ptr = b->end = b->buf; + PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF); + if (PerlIO_flush(PerlIONext(f)) != 0) + code = -1; + return code; } -#undef PerlIO_read SSize_t -PerlIO_read(PerlIO *f, void *vbuf, Size_t count) +PerlIOBuf_read(PerlIO *f, void *vbuf, Size_t count) { + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); STDCHAR *buf = (STDCHAR *) vbuf; if (f) { Size_t got = 0; - if (!f->ptr) - PerlIO_alloc_buf(f); - if ((f->oflags & (O_RDONLY|O_WRONLY|O_RDWR)) == O_WRONLY) + if (!b->ptr) + PerlIOBuf_alloc_buf(b); + if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) return 0; while (count > 0) { - SSize_t avail = (f->end - f->ptr); + SSize_t avail = (b->end - b->ptr); if ((SSize_t) count < avail) avail = count; if (avail > 0) { - Copy(f->ptr,buf,avail,char); + Copy(b->ptr,buf,avail,char); got += avail; - f->ptr += avail; + b->ptr += avail; count -= avail; buf += avail; } - if (count && (f->ptr >= f->end)) + if (count && (b->ptr >= b->end)) { PerlIO_flush(f); - f->ptr = f->end = f->buf; - avail = read(f->fd,f->ptr,f->bufsiz); + b->ptr = b->end = b->buf; + avail = PerlIO_read(PerlIONext(f),b->ptr,b->bufsiz); if (avail <= 0) { if (avail == 0) - f->flags |= PERLIO_F_EOF; - else if (errno == EINTR) - continue; + PerlIOBase(f)->flags |= PERLIO_F_EOF; else - f->flags |= PERLIO_F_ERROR; + PerlIOBase(f)->flags |= PERLIO_F_ERROR; break; } - f->end = f->buf+avail; - f->flags |= PERLIO_F_RDBUF; + b->end = b->buf+avail; + PerlIOBase(f)->flags |= PERLIO_F_RDBUF; } } return got; @@ -679,135 +1304,321 @@ PerlIO_read(PerlIO *f, void *vbuf, Size_t count) return 0; } -#undef PerlIO_getc -int -PerlIO_getc(PerlIO *f) +SSize_t +PerlIOBuf_unread(PerlIO *f, const void *vbuf, Size_t count) { - STDCHAR buf; - int count = PerlIO_read(f,&buf,1); - if (count == 1) - return (unsigned char) buf; - return -1; + const STDCHAR *buf = (const STDCHAR *) vbuf+count; + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + SSize_t unread = 0; + SSize_t avail; + if (!b->buf) + PerlIOBuf_alloc_buf(b); + if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) + PerlIO_flush(f); + if (b->buf) + { + if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) + { + avail = (b->ptr - b->buf); + if (avail > (SSize_t) count) + avail = count; + b->ptr -= avail; + } + else + { + avail = b->bufsiz; + if (avail > (SSize_t) count) + avail = count; + b->end = b->ptr + avail; + } + if (avail > 0) + { + buf -= avail; + if (buf != b->ptr) + { + Copy(buf,b->ptr,avail,char); + } + count -= avail; + unread += avail; + PerlIOBase(f)->flags &= ~ PERLIO_F_EOF; + } + } + return unread; } -#undef PerlIO_error -int -PerlIO_error(PerlIO *f) +SSize_t +PerlIOBuf_write(PerlIO *f, const void *vbuf, Size_t count) { - if (f) + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + const STDCHAR *buf = (const STDCHAR *) vbuf; + Size_t written = 0; + if (!b->buf) + PerlIOBuf_alloc_buf(b); + if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) + return 0; + while (count > 0) + { + SSize_t avail = b->bufsiz - (b->ptr - b->buf); + if ((SSize_t) count < avail) + avail = count; + 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,char); + count -= avail; + buf += avail; + written += avail; + b->ptr += avail; + } + } + if (b->ptr >= (b->buf + b->bufsiz)) + PerlIO_flush(f); + } + return written; +} + +IV +PerlIOBuf_seek(PerlIO *f, Off_t offset, int whence) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + int code; + code = PerlIO_flush(f); + if (code == 0) + { + PerlIOBase(f)->flags &= ~PERLIO_F_EOF; + code = PerlIO_seek(PerlIONext(f),offset,whence); + if (code == 0) + { + b->posn = PerlIO_tell(PerlIONext(f)); + } + } + return code; +} + +Off_t +PerlIOBuf_tell(PerlIO *f) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + Off_t posn = b->posn; + if (b->buf) + posn += (b->ptr - b->buf); + return posn; +} + +IV +PerlIOBuf_close(PerlIO *f) +{ + IV code = PerlIOBase_close(f); + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + if (b->buf && b->buf != (STDCHAR *) &b->oneword) { - return f->flags & PERLIO_F_ERROR; + Safefree(b->buf); } - return 1; + b->buf = NULL; + b->ptr = b->end = b->buf; + PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF); + return code; } -#undef PerlIO_clearerr void -PerlIO_clearerr(PerlIO *f) +PerlIOBuf_setlinebuf(PerlIO *f) { if (f) { - f->flags &= ~PERLIO_F_ERROR; + PerlIOBase(f)->flags &= ~PERLIO_F_LINEBUF; } } -#undef PerlIO_setlinebuf void -PerlIO_setlinebuf(PerlIO *f) +PerlIOBuf_set_cnt(PerlIO *f, int cnt) { - if (f) + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + dTHX; + if (!b->buf) + PerlIOBuf_alloc_buf(b); + b->ptr = b->end - cnt; + assert(b->ptr >= b->buf); +} + +STDCHAR * +PerlIOBuf_get_ptr(PerlIO *f) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + if (!b->buf) + PerlIOBuf_alloc_buf(b); + return b->ptr; +} + +int +PerlIOBuf_get_cnt(PerlIO *f) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + if (!b->buf) + PerlIOBuf_alloc_buf(b); + if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) + return (b->end - b->ptr); + return 0; +} + +STDCHAR * +PerlIOBuf_get_base(PerlIO *f) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + if (!b->buf) + PerlIOBuf_alloc_buf(b); + return b->buf; +} + +Size_t +PerlIOBuf_bufsiz(PerlIO *f) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + if (!b->buf) + PerlIOBuf_alloc_buf(b); + return (b->end - b->buf); +} + +void +PerlIOBuf_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + if (!b->buf) + PerlIOBuf_alloc_buf(b); + b->ptr = ptr; + if (PerlIO_get_cnt(f) != cnt || b->ptr < b->buf) { - f->flags &= ~PERLIO_F_LINEBUF; + dTHX; + assert(PerlIO_get_cnt(f) == cnt); + assert(b->ptr >= b->buf); } + PerlIOBase(f)->flags |= PERLIO_F_RDBUF; } -#undef PerlIO_write -SSize_t -PerlIO_write(PerlIO *f, const void *vbuf, Size_t count) +PerlIO_funcs PerlIO_perlio = { + "perlio", + sizeof(PerlIOBuf), + 0, + PerlIOBase_fileno, + PerlIOBuf_fdopen, + PerlIOBuf_open, + PerlIOBase_reopen, + PerlIOBuf_read, + PerlIOBuf_unread, + PerlIOBuf_write, + PerlIOBuf_seek, + PerlIOBuf_tell, + PerlIOBuf_close, + PerlIOBuf_flush, + PerlIOBase_eof, + PerlIOBase_error, + PerlIOBase_clearerr, + PerlIOBuf_setlinebuf, + PerlIOBuf_get_base, + PerlIOBuf_bufsiz, + PerlIOBuf_get_ptr, + PerlIOBuf_get_cnt, + PerlIOBuf_set_ptrcnt, +}; + +void +PerlIO_init(void) { - const STDCHAR *buf = (const STDCHAR *) vbuf; - Size_t written = 0; - if (f) + if (!_perlio) { - if (!f->buf) - PerlIO_alloc_buf(f); - if ((f->oflags & (O_RDONLY|O_WRONLY|O_RDWR)) == O_RDONLY) - return 0; - while (count > 0) - { - SSize_t avail = f->bufsiz - (f->ptr - f->buf); - if ((SSize_t) count < avail) - avail = count; - f->flags |= PERLIO_F_WRBUF; - if (f->flags & PERLIO_F_LINEBUF) - { - while (avail > 0) - { - int ch = *buf++; - *(f->ptr)++ = ch; - count--; - avail--; - written++; - if (ch == '\n') - { - PerlIO_flush(f); - break; - } - } - } - else - { - if (avail) - { - Copy(buf,f->ptr,avail,char); - count -= avail; - buf += avail; - written += avail; - f->ptr += avail; - } - } - if (f->ptr >= (f->buf + f->bufsiz)) - PerlIO_flush(f); - } + atexit(&PerlIO_cleanup); + PerlIO_fdopen(0,"r"); + PerlIO_fdopen(1,"w"); + PerlIO_fdopen(2,"w"); } - return written; } -#undef PerlIO_putc +#undef PerlIO_stdin +PerlIO * +PerlIO_stdin(void) +{ + if (!_perlio) + PerlIO_init(); + return _perlio[0]; +} + +#undef PerlIO_stdout +PerlIO * +PerlIO_stdout(void) +{ + if (!_perlio) + PerlIO_init(); + return _perlio[1]; +} + +#undef PerlIO_stderr +PerlIO * +PerlIO_stderr(void) +{ + if (!_perlio) + PerlIO_init(); + return _perlio[2]; +} + +/*--------------------------------------------------------------------------------------*/ + +#undef PerlIO_getname +char * +PerlIO_getname(PerlIO *f, char *buf) +{ + dTHX; + Perl_croak(aTHX_ "Don't know how to get file name"); + return NULL; +} + + +/*--------------------------------------------------------------------------------------*/ +/* Functions which can be called on any kind of PerlIO implemented + in terms of above +*/ + +#undef PerlIO_getc int -PerlIO_putc(PerlIO *f, int ch) +PerlIO_getc(PerlIO *f) { - STDCHAR buf = ch; - PerlIO_write(f,&buf,1); + STDCHAR buf; + int count = PerlIO_read(f,&buf,1); + if (count == 1) + return (unsigned char) buf; + return -1; } -#undef PerlIO_tell -Off_t -PerlIO_tell(PerlIO *f) +#undef PerlIO_putc +int +PerlIO_putc(PerlIO *f, int ch) { - Off_t posn = f->posn; - if (f->buf) - posn += (f->ptr - f->buf); - return posn; + STDCHAR buf = ch; + return PerlIO_write(f,&buf,1); } -#undef PerlIO_seek +#undef PerlIO_puts int -PerlIO_seek(PerlIO *f, Off_t offset, int whence) +PerlIO_puts(PerlIO *f, const char *s) { - int code; - code = PerlIO_flush(f); - if (code == 0) - { - f->flags &= ~PERLIO_F_EOF; - f->posn = PerlLIO_lseek(f->fd,offset,whence); - if (f->posn == (Off_t) -1) - { - f->posn = 0; - code = -1; - } - } - return code; + STRLEN len = strlen(s); + return PerlIO_write(f,s,len); } #undef PerlIO_rewind @@ -815,6 +1626,7 @@ void PerlIO_rewind(PerlIO *f) { PerlIO_seek(f,(Off_t)0,SEEK_SET); + PerlIO_clearerr(f); } #undef PerlIO_vprintf @@ -868,7 +1680,7 @@ PerlIO_tmpfile(void) f = PerlIO_fdopen(fd,"w+"); if (f) { - f->flags |= PERLIO_F_TEMP; + PerlIOBase(f)->flags |= PERLIO_F_TEMP; } unlink(SvPVX(sv)); SvREFCNT_dec(sv); @@ -876,45 +1688,17 @@ PerlIO_tmpfile(void) return f; } -#undef PerlIO_importFILE -PerlIO * -PerlIO_importFILE(FILE *f, int fl) -{ - int fd = fileno(f); - /* Should really push stdio discipline when we have them */ - return PerlIO_fdopen(fd,"r+"); -} - -#undef PerlIO_exportFILE -FILE * -PerlIO_exportFILE(PerlIO *f, int fl) -{ - PerlIO_flush(f); - /* Should really push stdio discipline when we have them */ - return fdopen(PerlIO_fileno(f),"r+"); -} - -#undef PerlIO_findFILE -FILE * -PerlIO_findFILE(PerlIO *f) -{ - return PerlIO_exportFILE(f,0); -} - -#undef PerlIO_releaseFILE -void -PerlIO_releaseFILE(PerlIO *p, FILE *f) -{ -} - #undef HAS_FSETPOS #undef HAS_FGETPOS -/*======================================================================================*/ - #endif /* USE_SFIO */ #endif /* PERLIO_IS_STDIO */ +/*======================================================================================*/ +/* Now some functions in terms of above which may be needed even if + we are not in true PerlIO mode + */ + #ifndef HAS_FSETPOS #undef PerlIO_setpos int