This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make die/warn and other diagnostics go to wherever STDERR happens
[perl5.git] / perlio.c
CommitLineData
760ac839
LW
1/* perlio.c
2 *
4eb8286e 3 * Copyright (c) 1996-1999, Nick Ing-Simmons
760ac839
LW
4 *
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.
7 *
8 */
9
c5be433b
GS
10#if !defined(PERL_IMPLICIT_SYS)
11
760ac839
LW
12#define VOIDUSED 1
13#include "config.h"
14
15#define PERLIO_NOT_STDIO 0
16#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
17#define PerlIO FILE
18#endif
19/*
20 * This file provides those parts of PerlIO abstraction
0f4eea8f 21 * which are not #defined in iperlsys.h.
760ac839
LW
22 * Which these are depends on various Configure #ifdef's
23 */
24
25#include "EXTERN.h"
864dbfa3 26#define PERL_IN_PERLIO_C
760ac839
LW
27#include "perl.h"
28
29#ifdef PERLIO_IS_STDIO
30
31void
8ac85365 32PerlIO_init(void)
760ac839
LW
33{
34 /* Does nothing (yet) except force this file to be included
35 in perl binary. That allows this file to force inclusion
36 of other functions that may be required by loadable
37 extensions e.g. for FileHandle::tmpfile
38 */
39}
40
33dcbb9a
PP
41#undef PerlIO_tmpfile
42PerlIO *
8ac85365 43PerlIO_tmpfile(void)
33dcbb9a
PP
44{
45 return tmpfile();
46}
47
760ac839
LW
48#else /* PERLIO_IS_STDIO */
49
50#ifdef USE_SFIO
51
52#undef HAS_FSETPOS
53#undef HAS_FGETPOS
54
55/* This section is just to make sure these functions
56 get pulled in from libsfio.a
57*/
58
59#undef PerlIO_tmpfile
60PerlIO *
c78749f2 61PerlIO_tmpfile(void)
760ac839
LW
62{
63 return sftmp(0);
64}
65
66void
c78749f2 67PerlIO_init(void)
760ac839
LW
68{
69 /* Force this file to be included in perl binary. Which allows
70 * this file to force inclusion of other functions that may be
71 * required by loadable extensions e.g. for FileHandle::tmpfile
72 */
73
74 /* Hack
75 * sfio does its own 'autoflush' on stdout in common cases.
76 * Flush results in a lot of lseek()s to regular files and
77 * lot of small writes to pipes.
78 */
79 sfset(sfstdout,SF_SHARE,0);
80}
81
17c3b450 82#else /* USE_SFIO */
760ac839
LW
83
84/* Implement all the PerlIO interface using stdio.
85 - this should be only file to include <stdio.h>
86*/
87
88#undef PerlIO_stderr
89PerlIO *
c78749f2 90PerlIO_stderr(void)
760ac839
LW
91{
92 return (PerlIO *) stderr;
93}
94
95#undef PerlIO_stdin
96PerlIO *
c78749f2 97PerlIO_stdin(void)
760ac839
LW
98{
99 return (PerlIO *) stdin;
100}
101
102#undef PerlIO_stdout
103PerlIO *
c78749f2 104PerlIO_stdout(void)
760ac839
LW
105{
106 return (PerlIO *) stdout;
107}
108
760ac839
LW
109#undef PerlIO_fast_gets
110int
c78749f2 111PerlIO_fast_gets(PerlIO *f)
760ac839
LW
112{
113#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
114 return 1;
115#else
116 return 0;
117#endif
118}
119
120#undef PerlIO_has_cntptr
121int
c78749f2 122PerlIO_has_cntptr(PerlIO *f)
760ac839
LW
123{
124#if defined(USE_STDIO_PTR)
125 return 1;
126#else
127 return 0;
128#endif
129}
130
131#undef PerlIO_canset_cnt
132int
c78749f2 133PerlIO_canset_cnt(PerlIO *f)
760ac839
LW
134{
135#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
136 return 1;
137#else
138 return 0;
139#endif
140}
141
142#undef PerlIO_set_cnt
143void
a20bf0c3 144PerlIO_set_cnt(PerlIO *f, int cnt)
760ac839 145{
961e40ee
SB
146 dTHX;
147 if (cnt < -1 && ckWARN_d(WARN_INTERNAL))
0453d815 148 Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d\n",cnt);
760ac839
LW
149#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
150 FILE_cnt(f) = cnt;
151#else
cea2e8a9 152 Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
760ac839
LW
153#endif
154}
155
156#undef PerlIO_set_ptrcnt
157void
a20bf0c3 158PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
760ac839 159{
961e40ee 160 dTHX;
409faa39 161#ifdef FILE_bufsiz
888911fc
CS
162 STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
163 int ec = e - ptr;
961e40ee 164 if (ptr > e + 1 && ckWARN_d(WARN_INTERNAL))
0453d815 165 Perl_warner(aTHX_ WARN_INTERNAL, "Setting ptr %p > end+1 %p\n", ptr, e + 1);
961e40ee 166 if (cnt != ec && ckWARN_d(WARN_INTERNAL))
0453d815 167 Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d, ptr implies %d\n",cnt,ec);
33dcbb9a 168#endif
760ac839 169#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
409faa39 170 FILE_ptr(f) = ptr;
760ac839 171#else
409faa39 172 Perl_croak(aTHX_ "Cannot set 'ptr' of FILE * on this system");
760ac839
LW
173#endif
174#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
409faa39 175 FILE_cnt(f) = cnt;
760ac839 176#else
409faa39 177 Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
760ac839
LW
178#endif
179}
180
181#undef PerlIO_get_cnt
182int
a20bf0c3 183PerlIO_get_cnt(PerlIO *f)
760ac839
LW
184{
185#ifdef FILE_cnt
186 return FILE_cnt(f);
187#else
961e40ee 188 dTHX;
cea2e8a9 189 Perl_croak(aTHX_ "Cannot get 'cnt' of FILE * on this system");
760ac839
LW
190 return -1;
191#endif
192}
193
194#undef PerlIO_get_bufsiz
195int
a20bf0c3 196PerlIO_get_bufsiz(PerlIO *f)
760ac839
LW
197{
198#ifdef FILE_bufsiz
199 return FILE_bufsiz(f);
200#else
961e40ee 201 dTHX;
cea2e8a9 202 Perl_croak(aTHX_ "Cannot get 'bufsiz' of FILE * on this system");
760ac839
LW
203 return -1;
204#endif
205}
206
207#undef PerlIO_get_ptr
888911fc 208STDCHAR *
a20bf0c3 209PerlIO_get_ptr(PerlIO *f)
760ac839
LW
210{
211#ifdef FILE_ptr
888911fc 212 return FILE_ptr(f);
760ac839 213#else
961e40ee 214 dTHX;
cea2e8a9 215 Perl_croak(aTHX_ "Cannot get 'ptr' of FILE * on this system");
760ac839
LW
216 return NULL;
217#endif
218}
219
220#undef PerlIO_get_base
888911fc 221STDCHAR *
a20bf0c3 222PerlIO_get_base(PerlIO *f)
760ac839
LW
223{
224#ifdef FILE_base
888911fc 225 return FILE_base(f);
760ac839 226#else
961e40ee 227 dTHX;
cea2e8a9 228 Perl_croak(aTHX_ "Cannot get 'base' of FILE * on this system");
760ac839
LW
229 return NULL;
230#endif
231}
232
233#undef PerlIO_has_base
234int
c78749f2 235PerlIO_has_base(PerlIO *f)
760ac839
LW
236{
237#ifdef FILE_base
238 return 1;
239#else
240 return 0;
241#endif
242}
243
244#undef PerlIO_puts
245int
c78749f2 246PerlIO_puts(PerlIO *f, const char *s)
760ac839
LW
247{
248 return fputs(s,f);
249}
250
251#undef PerlIO_open
252PerlIO *
c78749f2 253PerlIO_open(const char *path, const char *mode)
760ac839
LW
254{
255 return fopen(path,mode);
256}
257
258#undef PerlIO_fdopen
259PerlIO *
c78749f2 260PerlIO_fdopen(int fd, const char *mode)
760ac839
LW
261{
262 return fdopen(fd,mode);
263}
264
8c86a920
PP
265#undef PerlIO_reopen
266PerlIO *
c78749f2 267PerlIO_reopen(const char *name, const char *mode, PerlIO *f)
8c86a920
PP
268{
269 return freopen(name,mode,f);
270}
760ac839
LW
271
272#undef PerlIO_close
273int
c78749f2 274PerlIO_close(PerlIO *f)
760ac839
LW
275{
276 return fclose(f);
277}
278
279#undef PerlIO_eof
280int
c78749f2 281PerlIO_eof(PerlIO *f)
760ac839
LW
282{
283 return feof(f);
284}
285
8c86a920
PP
286#undef PerlIO_getname
287char *
a20bf0c3 288PerlIO_getname(PerlIO *f, char *buf)
8c86a920
PP
289{
290#ifdef VMS
291 return fgetname(f,buf);
292#else
961e40ee 293 dTHX;
cea2e8a9 294 Perl_croak(aTHX_ "Don't know how to get file name");
c64afb19 295 return NULL;
8c86a920
PP
296#endif
297}
298
760ac839
LW
299#undef PerlIO_getc
300int
c78749f2 301PerlIO_getc(PerlIO *f)
760ac839
LW
302{
303 return fgetc(f);
304}
305
306#undef PerlIO_error
307int
c78749f2 308PerlIO_error(PerlIO *f)
760ac839
LW
309{
310 return ferror(f);
311}
312
313#undef PerlIO_clearerr
314void
c78749f2 315PerlIO_clearerr(PerlIO *f)
760ac839
LW
316{
317 clearerr(f);
318}
319
320#undef PerlIO_flush
321int
c78749f2 322PerlIO_flush(PerlIO *f)
760ac839
LW
323{
324 return Fflush(f);
325}
326
327#undef PerlIO_fileno
328int
c78749f2 329PerlIO_fileno(PerlIO *f)
760ac839
LW
330{
331 return fileno(f);
332}
333
334#undef PerlIO_setlinebuf
335void
c78749f2 336PerlIO_setlinebuf(PerlIO *f)
760ac839
LW
337{
338#ifdef HAS_SETLINEBUF
339 setlinebuf(f);
340#else
3e3baf6d
TB
341# ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */
342 setvbuf(f, Nullch, _IOLBF, BUFSIZ);
343# else
760ac839 344 setvbuf(f, Nullch, _IOLBF, 0);
3e3baf6d 345# endif
760ac839
LW
346#endif
347}
348
349#undef PerlIO_putc
350int
c78749f2 351PerlIO_putc(PerlIO *f, int ch)
760ac839 352{
9010f3dd 353 return putc(ch,f);
760ac839
LW
354}
355
356#undef PerlIO_ungetc
357int
c78749f2 358PerlIO_ungetc(PerlIO *f, int ch)
760ac839 359{
9010f3dd 360 return ungetc(ch,f);
760ac839
LW
361}
362
363#undef PerlIO_read
5b54f415 364SSize_t
c78749f2 365PerlIO_read(PerlIO *f, void *buf, Size_t count)
760ac839
LW
366{
367 return fread(buf,1,count,f);
368}
369
370#undef PerlIO_write
5b54f415 371SSize_t
c78749f2 372PerlIO_write(PerlIO *f, const void *buf, Size_t count)
760ac839
LW
373{
374 return fwrite1(buf,1,count,f);
375}
376
377#undef PerlIO_vprintf
378int
c78749f2 379PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
760ac839
LW
380{
381 return vfprintf(f,fmt,ap);
382}
383
760ac839 384#undef PerlIO_tell
5ff3f7a4 385Off_t
c78749f2 386PerlIO_tell(PerlIO *f)
760ac839 387{
dad16317
RB
388#if defined(USE_64_BIT_STDIO) && defined(HAS_FTELLO) && !defined(USE_FTELL64)
389 return ftello(f);
390#else
760ac839 391 return ftell(f);
dad16317 392#endif
760ac839
LW
393}
394
395#undef PerlIO_seek
396int
c78749f2 397PerlIO_seek(PerlIO *f, Off_t offset, int whence)
760ac839 398{
dad16317
RB
399#if defined(USE_64_BIT_STDIO) && defined(HAS_FSEEKO) && !defined(USE_FSEEK64)
400 return fseeko(f,offset,whence);
401#else
760ac839 402 return fseek(f,offset,whence);
dad16317 403#endif
760ac839
LW
404}
405
406#undef PerlIO_rewind
407void
c78749f2 408PerlIO_rewind(PerlIO *f)
760ac839
LW
409{
410 rewind(f);
411}
412
413#undef PerlIO_printf
414int
760ac839 415PerlIO_printf(PerlIO *f,const char *fmt,...)
760ac839
LW
416{
417 va_list ap;
418 int result;
760ac839 419 va_start(ap,fmt);
760ac839
LW
420 result = vfprintf(f,fmt,ap);
421 va_end(ap);
422 return result;
423}
424
425#undef PerlIO_stdoutf
426int
760ac839 427PerlIO_stdoutf(const char *fmt,...)
760ac839
LW
428{
429 va_list ap;
430 int result;
760ac839 431 va_start(ap,fmt);
760ac839
LW
432 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
433 va_end(ap);
434 return result;
435}
436
437#undef PerlIO_tmpfile
438PerlIO *
c78749f2 439PerlIO_tmpfile(void)
760ac839
LW
440{
441 return tmpfile();
442}
443
444#undef PerlIO_importFILE
445PerlIO *
c78749f2 446PerlIO_importFILE(FILE *f, int fl)
760ac839
LW
447{
448 return f;
449}
450
451#undef PerlIO_exportFILE
452FILE *
c78749f2 453PerlIO_exportFILE(PerlIO *f, int fl)
760ac839
LW
454{
455 return f;
456}
457
458#undef PerlIO_findFILE
459FILE *
c78749f2 460PerlIO_findFILE(PerlIO *f)
760ac839
LW
461{
462 return f;
463}
464
465#undef PerlIO_releaseFILE
466void
c78749f2 467PerlIO_releaseFILE(PerlIO *p, FILE *f)
760ac839
LW
468{
469}
470
471void
c78749f2 472PerlIO_init(void)
760ac839
LW
473{
474 /* Does nothing (yet) except force this file to be included
475 in perl binary. That allows this file to force inclusion
476 of other functions that may be required by loadable
477 extensions e.g. for FileHandle::tmpfile
478 */
479}
480
481#endif /* USE_SFIO */
482#endif /* PERLIO_IS_STDIO */
483
484#ifndef HAS_FSETPOS
485#undef PerlIO_setpos
486int
c78749f2 487PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
760ac839
LW
488{
489 return PerlIO_seek(f,*pos,0);
490}
c411622e
PP
491#else
492#ifndef PERLIO_IS_STDIO
493#undef PerlIO_setpos
494int
c78749f2 495PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
c411622e 496{
2d4389e4 497#if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
d9b3e12d
JH
498 return fsetpos64(f, pos);
499#else
c411622e 500 return fsetpos(f, pos);
d9b3e12d 501#endif
c411622e
PP
502}
503#endif
760ac839
LW
504#endif
505
506#ifndef HAS_FGETPOS
507#undef PerlIO_getpos
508int
c78749f2 509PerlIO_getpos(PerlIO *f, Fpos_t *pos)
760ac839
LW
510{
511 *pos = PerlIO_tell(f);
512 return 0;
513}
c411622e
PP
514#else
515#ifndef PERLIO_IS_STDIO
516#undef PerlIO_getpos
517int
c78749f2 518PerlIO_getpos(PerlIO *f, Fpos_t *pos)
c411622e 519{
2d4389e4 520#if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
d9b3e12d
JH
521 return fgetpos64(f, pos);
522#else
c411622e 523 return fgetpos(f, pos);
d9b3e12d 524#endif
c411622e
PP
525}
526#endif
760ac839
LW
527#endif
528
529#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
530
531int
c78749f2 532vprintf(char *pat, char *args)
662a7e3f
CS
533{
534 _doprnt(pat, args, stdout);
535 return 0; /* wrong, but perl doesn't use the return value */
536}
537
538int
c78749f2 539vfprintf(FILE *fd, char *pat, char *args)
760ac839
LW
540{
541 _doprnt(pat, args, fd);
542 return 0; /* wrong, but perl doesn't use the return value */
543}
544
545#endif
546
547#ifndef PerlIO_vsprintf
548int
8ac85365 549PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
760ac839
LW
550{
551 int val = vsprintf(s, fmt, ap);
552 if (n >= 0)
553 {
8c86a920 554 if (strlen(s) >= (STRLEN)n)
760ac839 555 {
bf49b057
GS
556 dTHX;
557 PerlIO_puts(Perl_error_log,"panic: sprintf overflow - memory corrupted!\n");
558 my_exit(1);
760ac839
LW
559 }
560 }
561 return val;
562}
563#endif
564
565#ifndef PerlIO_sprintf
566int
760ac839 567PerlIO_sprintf(char *s, int n, const char *fmt,...)
760ac839
LW
568{
569 va_list ap;
570 int result;
760ac839 571 va_start(ap,fmt);
760ac839
LW
572 result = PerlIO_vsprintf(s, n, fmt, ap);
573 va_end(ap);
574 return result;
575}
576#endif
577
c5be433b
GS
578#endif /* !PERL_IMPLICIT_SYS */
579