Commit | Line | Data |
---|---|---|
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 | ||
31 | void | |
8ac85365 | 32 | PerlIO_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 | 41 | #undef PerlIO_tmpfile |
42 | PerlIO * | |
8ac85365 | 43 | PerlIO_tmpfile(void) |
33dcbb9a | 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 | |
60 | PerlIO * | |
c78749f2 | 61 | PerlIO_tmpfile(void) |
760ac839 LW |
62 | { |
63 | return sftmp(0); | |
64 | } | |
65 | ||
66 | void | |
c78749f2 | 67 | PerlIO_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 | |
89 | PerlIO * | |
c78749f2 | 90 | PerlIO_stderr(void) |
760ac839 LW |
91 | { |
92 | return (PerlIO *) stderr; | |
93 | } | |
94 | ||
95 | #undef PerlIO_stdin | |
96 | PerlIO * | |
c78749f2 | 97 | PerlIO_stdin(void) |
760ac839 LW |
98 | { |
99 | return (PerlIO *) stdin; | |
100 | } | |
101 | ||
102 | #undef PerlIO_stdout | |
103 | PerlIO * | |
c78749f2 | 104 | PerlIO_stdout(void) |
760ac839 LW |
105 | { |
106 | return (PerlIO *) stdout; | |
107 | } | |
108 | ||
760ac839 LW |
109 | #undef PerlIO_fast_gets |
110 | int | |
c78749f2 | 111 | PerlIO_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 | |
121 | int | |
c78749f2 | 122 | PerlIO_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 | |
132 | int | |
c78749f2 | 133 | PerlIO_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 | |
143 | void | |
a20bf0c3 | 144 | PerlIO_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 | |
157 | void | |
a20bf0c3 | 158 | PerlIO_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 | |
182 | int | |
a20bf0c3 | 183 | PerlIO_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 | |
195 | int | |
a20bf0c3 | 196 | PerlIO_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 | 208 | STDCHAR * |
a20bf0c3 | 209 | PerlIO_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 | 221 | STDCHAR * |
a20bf0c3 | 222 | PerlIO_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 | |
234 | int | |
c78749f2 | 235 | PerlIO_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 | |
245 | int | |
c78749f2 | 246 | PerlIO_puts(PerlIO *f, const char *s) |
760ac839 LW |
247 | { |
248 | return fputs(s,f); | |
249 | } | |
250 | ||
251 | #undef PerlIO_open | |
252 | PerlIO * | |
c78749f2 | 253 | PerlIO_open(const char *path, const char *mode) |
760ac839 LW |
254 | { |
255 | return fopen(path,mode); | |
256 | } | |
257 | ||
258 | #undef PerlIO_fdopen | |
259 | PerlIO * | |
c78749f2 | 260 | PerlIO_fdopen(int fd, const char *mode) |
760ac839 LW |
261 | { |
262 | return fdopen(fd,mode); | |
263 | } | |
264 | ||
8c86a920 | 265 | #undef PerlIO_reopen |
266 | PerlIO * | |
c78749f2 | 267 | PerlIO_reopen(const char *name, const char *mode, PerlIO *f) |
8c86a920 | 268 | { |
269 | return freopen(name,mode,f); | |
270 | } | |
760ac839 LW |
271 | |
272 | #undef PerlIO_close | |
273 | int | |
c78749f2 | 274 | PerlIO_close(PerlIO *f) |
760ac839 LW |
275 | { |
276 | return fclose(f); | |
277 | } | |
278 | ||
279 | #undef PerlIO_eof | |
280 | int | |
c78749f2 | 281 | PerlIO_eof(PerlIO *f) |
760ac839 LW |
282 | { |
283 | return feof(f); | |
284 | } | |
285 | ||
8c86a920 | 286 | #undef PerlIO_getname |
287 | char * | |
a20bf0c3 | 288 | PerlIO_getname(PerlIO *f, char *buf) |
8c86a920 | 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 | 296 | #endif |
297 | } | |
298 | ||
760ac839 LW |
299 | #undef PerlIO_getc |
300 | int | |
c78749f2 | 301 | PerlIO_getc(PerlIO *f) |
760ac839 LW |
302 | { |
303 | return fgetc(f); | |
304 | } | |
305 | ||
306 | #undef PerlIO_error | |
307 | int | |
c78749f2 | 308 | PerlIO_error(PerlIO *f) |
760ac839 LW |
309 | { |
310 | return ferror(f); | |
311 | } | |
312 | ||
313 | #undef PerlIO_clearerr | |
314 | void | |
c78749f2 | 315 | PerlIO_clearerr(PerlIO *f) |
760ac839 LW |
316 | { |
317 | clearerr(f); | |
318 | } | |
319 | ||
320 | #undef PerlIO_flush | |
321 | int | |
c78749f2 | 322 | PerlIO_flush(PerlIO *f) |
760ac839 LW |
323 | { |
324 | return Fflush(f); | |
325 | } | |
326 | ||
327 | #undef PerlIO_fileno | |
328 | int | |
c78749f2 | 329 | PerlIO_fileno(PerlIO *f) |
760ac839 LW |
330 | { |
331 | return fileno(f); | |
332 | } | |
333 | ||
334 | #undef PerlIO_setlinebuf | |
335 | void | |
c78749f2 | 336 | PerlIO_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 | |
350 | int | |
c78749f2 | 351 | PerlIO_putc(PerlIO *f, int ch) |
760ac839 | 352 | { |
9010f3dd | 353 | return putc(ch,f); |
760ac839 LW |
354 | } |
355 | ||
356 | #undef PerlIO_ungetc | |
357 | int | |
c78749f2 | 358 | PerlIO_ungetc(PerlIO *f, int ch) |
760ac839 | 359 | { |
9010f3dd | 360 | return ungetc(ch,f); |
760ac839 LW |
361 | } |
362 | ||
363 | #undef PerlIO_read | |
5b54f415 | 364 | SSize_t |
c78749f2 | 365 | PerlIO_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 | 371 | SSize_t |
c78749f2 | 372 | PerlIO_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 | |
378 | int | |
c78749f2 | 379 | PerlIO_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 | 385 | Off_t |
c78749f2 | 386 | PerlIO_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 | |
396 | int | |
c78749f2 | 397 | PerlIO_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 | |
407 | void | |
c78749f2 | 408 | PerlIO_rewind(PerlIO *f) |
760ac839 LW |
409 | { |
410 | rewind(f); | |
411 | } | |
412 | ||
413 | #undef PerlIO_printf | |
414 | int | |
760ac839 | 415 | PerlIO_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 | |
426 | int | |
760ac839 | 427 | PerlIO_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 | |
438 | PerlIO * | |
c78749f2 | 439 | PerlIO_tmpfile(void) |
760ac839 LW |
440 | { |
441 | return tmpfile(); | |
442 | } | |
443 | ||
444 | #undef PerlIO_importFILE | |
445 | PerlIO * | |
c78749f2 | 446 | PerlIO_importFILE(FILE *f, int fl) |
760ac839 LW |
447 | { |
448 | return f; | |
449 | } | |
450 | ||
451 | #undef PerlIO_exportFILE | |
452 | FILE * | |
c78749f2 | 453 | PerlIO_exportFILE(PerlIO *f, int fl) |
760ac839 LW |
454 | { |
455 | return f; | |
456 | } | |
457 | ||
458 | #undef PerlIO_findFILE | |
459 | FILE * | |
c78749f2 | 460 | PerlIO_findFILE(PerlIO *f) |
760ac839 LW |
461 | { |
462 | return f; | |
463 | } | |
464 | ||
465 | #undef PerlIO_releaseFILE | |
466 | void | |
c78749f2 | 467 | PerlIO_releaseFILE(PerlIO *p, FILE *f) |
760ac839 LW |
468 | { |
469 | } | |
470 | ||
471 | void | |
c78749f2 | 472 | PerlIO_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 | |
486 | int | |
c78749f2 | 487 | PerlIO_setpos(PerlIO *f, const Fpos_t *pos) |
760ac839 LW |
488 | { |
489 | return PerlIO_seek(f,*pos,0); | |
490 | } | |
c411622e | 491 | #else |
492 | #ifndef PERLIO_IS_STDIO | |
493 | #undef PerlIO_setpos | |
494 | int | |
c78749f2 | 495 | PerlIO_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 | 502 | } |
503 | #endif | |
760ac839 LW |
504 | #endif |
505 | ||
506 | #ifndef HAS_FGETPOS | |
507 | #undef PerlIO_getpos | |
508 | int | |
c78749f2 | 509 | PerlIO_getpos(PerlIO *f, Fpos_t *pos) |
760ac839 LW |
510 | { |
511 | *pos = PerlIO_tell(f); | |
512 | return 0; | |
513 | } | |
c411622e | 514 | #else |
515 | #ifndef PERLIO_IS_STDIO | |
516 | #undef PerlIO_getpos | |
517 | int | |
c78749f2 | 518 | PerlIO_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 | 525 | } |
526 | #endif | |
760ac839 LW |
527 | #endif |
528 | ||
529 | #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF) | |
530 | ||
531 | int | |
c78749f2 | 532 | vprintf(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 | ||
538 | int | |
c78749f2 | 539 | vfprintf(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 | |
548 | int | |
8ac85365 | 549 | PerlIO_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 LW |
555 | { |
556 | PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n"); | |
cea2e8a9 GS |
557 | { |
558 | dTHX; | |
559 | my_exit(1); | |
560 | } | |
760ac839 LW |
561 | } |
562 | } | |
563 | return val; | |
564 | } | |
565 | #endif | |
566 | ||
567 | #ifndef PerlIO_sprintf | |
568 | int | |
760ac839 | 569 | PerlIO_sprintf(char *s, int n, const char *fmt,...) |
760ac839 LW |
570 | { |
571 | va_list ap; | |
572 | int result; | |
760ac839 | 573 | va_start(ap,fmt); |
760ac839 LW |
574 | result = PerlIO_vsprintf(s, n, fmt, ap); |
575 | va_end(ap); | |
576 | return result; | |
577 | } | |
578 | #endif | |
579 | ||
c5be433b GS |
580 | #endif /* !PERL_IMPLICIT_SYS */ |
581 |