3 * Copyright (c) 1996-2000, Nick Ing-Simmons
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
18 #define PERLIO_NOT_STDIO 0
19 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
23 * This file provides those parts of PerlIO abstraction
24 * which are not #defined in iperlsys.h.
25 * Which these are depends on various Configure #ifdef's
29 #define PERL_IN_PERLIO_C
32 #if !defined(PERL_IMPLICIT_SYS)
34 #ifdef PERLIO_IS_STDIO
39 /* Does nothing (yet) except force this file to be included
40 in perl binary. That allows this file to force inclusion
41 of other functions that may be required by loadable
42 extensions e.g. for FileHandle::tmpfile
53 #else /* PERLIO_IS_STDIO */
60 /* This section is just to make sure these functions
61 get pulled in from libsfio.a
74 /* Force this file to be included in perl binary. Which allows
75 * this file to force inclusion of other functions that may be
76 * required by loadable extensions e.g. for FileHandle::tmpfile
80 * sfio does its own 'autoflush' on stdout in common cases.
81 * Flush results in a lot of lseek()s to regular files and
82 * lot of small writes to pipes.
84 sfset(sfstdout,SF_SHARE,0);
89 /* Implement all the PerlIO interface using stdio.
90 - this should be only file to include <stdio.h>
97 return (PerlIO *) stderr;
104 return (PerlIO *) stdin;
111 return (PerlIO *) stdout;
114 #undef PerlIO_fast_gets
116 PerlIO_fast_gets(PerlIO *f)
118 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
125 #undef PerlIO_has_cntptr
127 PerlIO_has_cntptr(PerlIO *f)
129 #if defined(USE_STDIO_PTR)
136 #undef PerlIO_canset_cnt
138 PerlIO_canset_cnt(PerlIO *f)
140 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
147 #undef PerlIO_set_cnt
149 PerlIO_set_cnt(PerlIO *f, int cnt)
152 if (cnt < -1 && ckWARN_d(WARN_INTERNAL))
153 Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d\n",cnt);
154 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
157 Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
161 #undef PerlIO_set_ptrcnt
163 PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
167 STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
169 if (ptr > e + 1 && ckWARN_d(WARN_INTERNAL))
170 Perl_warner(aTHX_ WARN_INTERNAL, "Setting ptr %p > end+1 %p\n", ptr, e + 1);
171 if (cnt != ec && ckWARN_d(WARN_INTERNAL))
172 Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d, ptr implies %d\n",cnt,ec);
174 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
177 Perl_croak(aTHX_ "Cannot set 'ptr' of FILE * on this system");
179 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
182 Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
186 #undef PerlIO_get_cnt
188 PerlIO_get_cnt(PerlIO *f)
194 Perl_croak(aTHX_ "Cannot get 'cnt' of FILE * on this system");
199 #undef PerlIO_get_bufsiz
201 PerlIO_get_bufsiz(PerlIO *f)
204 return FILE_bufsiz(f);
207 Perl_croak(aTHX_ "Cannot get 'bufsiz' of FILE * on this system");
212 #undef PerlIO_get_ptr
214 PerlIO_get_ptr(PerlIO *f)
220 Perl_croak(aTHX_ "Cannot get 'ptr' of FILE * on this system");
225 #undef PerlIO_get_base
227 PerlIO_get_base(PerlIO *f)
233 Perl_croak(aTHX_ "Cannot get 'base' of FILE * on this system");
238 #undef PerlIO_has_base
240 PerlIO_has_base(PerlIO *f)
251 PerlIO_puts(PerlIO *f, const char *s)
258 PerlIO_open(const char *path, const char *mode)
260 return fopen(path,mode);
265 PerlIO_fdopen(int fd, const char *mode)
267 return fdopen(fd,mode);
272 PerlIO_reopen(const char *name, const char *mode, PerlIO *f)
274 return freopen(name,mode,f);
279 PerlIO_close(PerlIO *f)
286 PerlIO_eof(PerlIO *f)
291 #undef PerlIO_getname
293 PerlIO_getname(PerlIO *f, char *buf)
296 return fgetname(f,buf);
299 Perl_croak(aTHX_ "Don't know how to get file name");
306 PerlIO_getc(PerlIO *f)
313 PerlIO_error(PerlIO *f)
318 #undef PerlIO_clearerr
320 PerlIO_clearerr(PerlIO *f)
327 PerlIO_flush(PerlIO *f)
334 PerlIO_fileno(PerlIO *f)
339 #undef PerlIO_setlinebuf
341 PerlIO_setlinebuf(PerlIO *f)
343 #ifdef HAS_SETLINEBUF
346 # ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */
347 setvbuf(f, Nullch, _IOLBF, BUFSIZ);
349 setvbuf(f, Nullch, _IOLBF, 0);
356 PerlIO_putc(PerlIO *f, int ch)
363 PerlIO_ungetc(PerlIO *f, int ch)
370 PerlIO_read(PerlIO *f, void *buf, Size_t count)
372 return fread(buf,1,count,f);
377 PerlIO_write(PerlIO *f, const void *buf, Size_t count)
379 return fwrite1(buf,1,count,f);
382 #undef PerlIO_vprintf
384 PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
386 return vfprintf(f,fmt,ap);
391 PerlIO_tell(PerlIO *f)
393 #if defined(USE_64_BIT_STDIO) && defined(HAS_FTELLO) && !defined(USE_FTELL64)
402 PerlIO_seek(PerlIO *f, Off_t offset, int whence)
404 #if defined(USE_64_BIT_STDIO) && defined(HAS_FSEEKO) && !defined(USE_FSEEK64)
405 return fseeko(f,offset,whence);
407 return fseek(f,offset,whence);
413 PerlIO_rewind(PerlIO *f)
420 PerlIO_printf(PerlIO *f,const char *fmt,...)
425 result = vfprintf(f,fmt,ap);
430 #undef PerlIO_stdoutf
432 PerlIO_stdoutf(const char *fmt,...)
437 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
442 #undef PerlIO_tmpfile
449 #undef PerlIO_importFILE
451 PerlIO_importFILE(FILE *f, int fl)
456 #undef PerlIO_exportFILE
458 PerlIO_exportFILE(PerlIO *f, int fl)
463 #undef PerlIO_findFILE
465 PerlIO_findFILE(PerlIO *f)
470 #undef PerlIO_releaseFILE
472 PerlIO_releaseFILE(PerlIO *p, FILE *f)
479 /* Does nothing (yet) except force this file to be included
480 in perl binary. That allows this file to force inclusion
481 of other functions that may be required by loadable
482 extensions e.g. for FileHandle::tmpfile
486 #endif /* USE_SFIO */
487 #endif /* PERLIO_IS_STDIO */
492 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
494 return PerlIO_seek(f,*pos,0);
497 #ifndef PERLIO_IS_STDIO
500 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
502 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
503 return fsetpos64(f, pos);
505 return fsetpos(f, pos);
514 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
516 *pos = PerlIO_tell(f);
520 #ifndef PERLIO_IS_STDIO
523 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
525 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
526 return fgetpos64(f, pos);
528 return fgetpos(f, pos);
534 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
537 vprintf(char *pat, char *args)
539 _doprnt(pat, args, stdout);
540 return 0; /* wrong, but perl doesn't use the return value */
544 vfprintf(FILE *fd, char *pat, char *args)
546 _doprnt(pat, args, fd);
547 return 0; /* wrong, but perl doesn't use the return value */
552 #ifndef PerlIO_vsprintf
554 PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
556 int val = vsprintf(s, fmt, ap);
559 if (strlen(s) >= (STRLEN)n)
562 PerlIO_puts(Perl_error_log,"panic: sprintf overflow - memory corrupted!\n");
570 #ifndef PerlIO_sprintf
572 PerlIO_sprintf(char *s, int n, const char *fmt,...)
577 result = PerlIO_vsprintf(s, n, fmt, ap);
583 #endif /* !PERL_IMPLICIT_SYS */