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 | |
c78749f2 | 144 | PerlIO_set_cnt(PerlIO *f, int cnt) |
760ac839 | 145 | { |
0453d815 PM |
146 | if (cnt < -1 && ckWARN_s(WARN_INTERNAL)) |
147 | Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d\n",cnt); | |
760ac839 LW |
148 | #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE) |
149 | FILE_cnt(f) = cnt; | |
150 | #else | |
cea2e8a9 | 151 | Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system"); |
760ac839 LW |
152 | #endif |
153 | } | |
154 | ||
155 | #undef PerlIO_set_ptrcnt | |
156 | void | |
c78749f2 | 157 | PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt) |
760ac839 | 158 | { |
33dcbb9a | 159 | #ifdef FILE_bufsiz |
888911fc CS |
160 | STDCHAR *e = FILE_base(f) + FILE_bufsiz(f); |
161 | int ec = e - ptr; | |
0453d815 PM |
162 | if (ptr > e + 1 && ckWARN_s(WARN_INTERNAL)) |
163 | Perl_warner(aTHX_ WARN_INTERNAL, "Setting ptr %p > end+1 %p\n", ptr, e + 1); | |
164 | if (cnt != ec && ckWARN_s(WARN_INTERNAL)) | |
165 | Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d, ptr implies %d\n",cnt,ec); | |
33dcbb9a | 166 | #endif |
760ac839 | 167 | #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) |
888911fc | 168 | FILE_ptr(f) = ptr; |
760ac839 | 169 | #else |
cea2e8a9 | 170 | Perl_croak(aTHX_ "Cannot set 'ptr' of FILE * on this system"); |
760ac839 LW |
171 | #endif |
172 | #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE) | |
173 | FILE_cnt(f) = cnt; | |
174 | #else | |
cea2e8a9 | 175 | Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system"); |
760ac839 LW |
176 | #endif |
177 | } | |
178 | ||
179 | #undef PerlIO_get_cnt | |
180 | int | |
c78749f2 | 181 | PerlIO_get_cnt(PerlIO *f) |
760ac839 LW |
182 | { |
183 | #ifdef FILE_cnt | |
184 | return FILE_cnt(f); | |
185 | #else | |
cea2e8a9 | 186 | Perl_croak(aTHX_ "Cannot get 'cnt' of FILE * on this system"); |
760ac839 LW |
187 | return -1; |
188 | #endif | |
189 | } | |
190 | ||
191 | #undef PerlIO_get_bufsiz | |
192 | int | |
c78749f2 | 193 | PerlIO_get_bufsiz(PerlIO *f) |
760ac839 LW |
194 | { |
195 | #ifdef FILE_bufsiz | |
196 | return FILE_bufsiz(f); | |
197 | #else | |
cea2e8a9 | 198 | Perl_croak(aTHX_ "Cannot get 'bufsiz' of FILE * on this system"); |
760ac839 LW |
199 | return -1; |
200 | #endif | |
201 | } | |
202 | ||
203 | #undef PerlIO_get_ptr | |
888911fc | 204 | STDCHAR * |
c78749f2 | 205 | PerlIO_get_ptr(PerlIO *f) |
760ac839 LW |
206 | { |
207 | #ifdef FILE_ptr | |
888911fc | 208 | return FILE_ptr(f); |
760ac839 | 209 | #else |
cea2e8a9 | 210 | Perl_croak(aTHX_ "Cannot get 'ptr' of FILE * on this system"); |
760ac839 LW |
211 | return NULL; |
212 | #endif | |
213 | } | |
214 | ||
215 | #undef PerlIO_get_base | |
888911fc | 216 | STDCHAR * |
c78749f2 | 217 | PerlIO_get_base(PerlIO *f) |
760ac839 LW |
218 | { |
219 | #ifdef FILE_base | |
888911fc | 220 | return FILE_base(f); |
760ac839 | 221 | #else |
cea2e8a9 | 222 | Perl_croak(aTHX_ "Cannot get 'base' of FILE * on this system"); |
760ac839 LW |
223 | return NULL; |
224 | #endif | |
225 | } | |
226 | ||
227 | #undef PerlIO_has_base | |
228 | int | |
c78749f2 | 229 | PerlIO_has_base(PerlIO *f) |
760ac839 LW |
230 | { |
231 | #ifdef FILE_base | |
232 | return 1; | |
233 | #else | |
234 | return 0; | |
235 | #endif | |
236 | } | |
237 | ||
238 | #undef PerlIO_puts | |
239 | int | |
c78749f2 | 240 | PerlIO_puts(PerlIO *f, const char *s) |
760ac839 LW |
241 | { |
242 | return fputs(s,f); | |
243 | } | |
244 | ||
245 | #undef PerlIO_open | |
246 | PerlIO * | |
c78749f2 | 247 | PerlIO_open(const char *path, const char *mode) |
760ac839 LW |
248 | { |
249 | return fopen(path,mode); | |
250 | } | |
251 | ||
252 | #undef PerlIO_fdopen | |
253 | PerlIO * | |
c78749f2 | 254 | PerlIO_fdopen(int fd, const char *mode) |
760ac839 LW |
255 | { |
256 | return fdopen(fd,mode); | |
257 | } | |
258 | ||
8c86a920 | 259 | #undef PerlIO_reopen |
260 | PerlIO * | |
c78749f2 | 261 | PerlIO_reopen(const char *name, const char *mode, PerlIO *f) |
8c86a920 | 262 | { |
263 | return freopen(name,mode,f); | |
264 | } | |
760ac839 LW |
265 | |
266 | #undef PerlIO_close | |
267 | int | |
c78749f2 | 268 | PerlIO_close(PerlIO *f) |
760ac839 LW |
269 | { |
270 | return fclose(f); | |
271 | } | |
272 | ||
273 | #undef PerlIO_eof | |
274 | int | |
c78749f2 | 275 | PerlIO_eof(PerlIO *f) |
760ac839 LW |
276 | { |
277 | return feof(f); | |
278 | } | |
279 | ||
8c86a920 | 280 | #undef PerlIO_getname |
281 | char * | |
c78749f2 | 282 | PerlIO_getname(PerlIO *f, char *buf) |
8c86a920 | 283 | { |
284 | #ifdef VMS | |
285 | return fgetname(f,buf); | |
286 | #else | |
cea2e8a9 | 287 | Perl_croak(aTHX_ "Don't know how to get file name"); |
c64afb19 | 288 | return NULL; |
8c86a920 | 289 | #endif |
290 | } | |
291 | ||
760ac839 LW |
292 | #undef PerlIO_getc |
293 | int | |
c78749f2 | 294 | PerlIO_getc(PerlIO *f) |
760ac839 LW |
295 | { |
296 | return fgetc(f); | |
297 | } | |
298 | ||
299 | #undef PerlIO_error | |
300 | int | |
c78749f2 | 301 | PerlIO_error(PerlIO *f) |
760ac839 LW |
302 | { |
303 | return ferror(f); | |
304 | } | |
305 | ||
306 | #undef PerlIO_clearerr | |
307 | void | |
c78749f2 | 308 | PerlIO_clearerr(PerlIO *f) |
760ac839 LW |
309 | { |
310 | clearerr(f); | |
311 | } | |
312 | ||
313 | #undef PerlIO_flush | |
314 | int | |
c78749f2 | 315 | PerlIO_flush(PerlIO *f) |
760ac839 LW |
316 | { |
317 | return Fflush(f); | |
318 | } | |
319 | ||
320 | #undef PerlIO_fileno | |
321 | int | |
c78749f2 | 322 | PerlIO_fileno(PerlIO *f) |
760ac839 LW |
323 | { |
324 | return fileno(f); | |
325 | } | |
326 | ||
327 | #undef PerlIO_setlinebuf | |
328 | void | |
c78749f2 | 329 | PerlIO_setlinebuf(PerlIO *f) |
760ac839 LW |
330 | { |
331 | #ifdef HAS_SETLINEBUF | |
332 | setlinebuf(f); | |
333 | #else | |
3e3baf6d TB |
334 | # ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */ |
335 | setvbuf(f, Nullch, _IOLBF, BUFSIZ); | |
336 | # else | |
760ac839 | 337 | setvbuf(f, Nullch, _IOLBF, 0); |
3e3baf6d | 338 | # endif |
760ac839 LW |
339 | #endif |
340 | } | |
341 | ||
342 | #undef PerlIO_putc | |
343 | int | |
c78749f2 | 344 | PerlIO_putc(PerlIO *f, int ch) |
760ac839 | 345 | { |
9010f3dd | 346 | return putc(ch,f); |
760ac839 LW |
347 | } |
348 | ||
349 | #undef PerlIO_ungetc | |
350 | int | |
c78749f2 | 351 | PerlIO_ungetc(PerlIO *f, int ch) |
760ac839 | 352 | { |
9010f3dd | 353 | return ungetc(ch,f); |
760ac839 LW |
354 | } |
355 | ||
356 | #undef PerlIO_read | |
5b54f415 | 357 | SSize_t |
c78749f2 | 358 | PerlIO_read(PerlIO *f, void *buf, Size_t count) |
760ac839 LW |
359 | { |
360 | return fread(buf,1,count,f); | |
361 | } | |
362 | ||
363 | #undef PerlIO_write | |
5b54f415 | 364 | SSize_t |
c78749f2 | 365 | PerlIO_write(PerlIO *f, const void *buf, Size_t count) |
760ac839 LW |
366 | { |
367 | return fwrite1(buf,1,count,f); | |
368 | } | |
369 | ||
370 | #undef PerlIO_vprintf | |
371 | int | |
c78749f2 | 372 | PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap) |
760ac839 LW |
373 | { |
374 | return vfprintf(f,fmt,ap); | |
375 | } | |
376 | ||
760ac839 | 377 | #undef PerlIO_tell |
5ff3f7a4 | 378 | Off_t |
c78749f2 | 379 | PerlIO_tell(PerlIO *f) |
760ac839 | 380 | { |
5ff3f7a4 GS |
381 | #ifdef HAS_FTELLO |
382 | return ftello(f); | |
383 | #else | |
760ac839 | 384 | return ftell(f); |
5ff3f7a4 | 385 | #endif |
760ac839 LW |
386 | } |
387 | ||
388 | #undef PerlIO_seek | |
389 | int | |
c78749f2 | 390 | PerlIO_seek(PerlIO *f, Off_t offset, int whence) |
760ac839 | 391 | { |
5ff3f7a4 GS |
392 | #ifdef HAS_FSEEKO |
393 | return fseeko(f,offset,whence); | |
394 | #else | |
760ac839 | 395 | return fseek(f,offset,whence); |
5ff3f7a4 | 396 | #endif |
760ac839 LW |
397 | } |
398 | ||
399 | #undef PerlIO_rewind | |
400 | void | |
c78749f2 | 401 | PerlIO_rewind(PerlIO *f) |
760ac839 LW |
402 | { |
403 | rewind(f); | |
404 | } | |
405 | ||
406 | #undef PerlIO_printf | |
407 | int | |
760ac839 | 408 | PerlIO_printf(PerlIO *f,const char *fmt,...) |
760ac839 LW |
409 | { |
410 | va_list ap; | |
411 | int result; | |
760ac839 | 412 | va_start(ap,fmt); |
760ac839 LW |
413 | result = vfprintf(f,fmt,ap); |
414 | va_end(ap); | |
415 | return result; | |
416 | } | |
417 | ||
418 | #undef PerlIO_stdoutf | |
419 | int | |
760ac839 | 420 | PerlIO_stdoutf(const char *fmt,...) |
760ac839 LW |
421 | { |
422 | va_list ap; | |
423 | int result; | |
760ac839 | 424 | va_start(ap,fmt); |
760ac839 LW |
425 | result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap); |
426 | va_end(ap); | |
427 | return result; | |
428 | } | |
429 | ||
430 | #undef PerlIO_tmpfile | |
431 | PerlIO * | |
c78749f2 | 432 | PerlIO_tmpfile(void) |
760ac839 LW |
433 | { |
434 | return tmpfile(); | |
435 | } | |
436 | ||
437 | #undef PerlIO_importFILE | |
438 | PerlIO * | |
c78749f2 | 439 | PerlIO_importFILE(FILE *f, int fl) |
760ac839 LW |
440 | { |
441 | return f; | |
442 | } | |
443 | ||
444 | #undef PerlIO_exportFILE | |
445 | FILE * | |
c78749f2 | 446 | PerlIO_exportFILE(PerlIO *f, int fl) |
760ac839 LW |
447 | { |
448 | return f; | |
449 | } | |
450 | ||
451 | #undef PerlIO_findFILE | |
452 | FILE * | |
c78749f2 | 453 | PerlIO_findFILE(PerlIO *f) |
760ac839 LW |
454 | { |
455 | return f; | |
456 | } | |
457 | ||
458 | #undef PerlIO_releaseFILE | |
459 | void | |
c78749f2 | 460 | PerlIO_releaseFILE(PerlIO *p, FILE *f) |
760ac839 LW |
461 | { |
462 | } | |
463 | ||
464 | void | |
c78749f2 | 465 | PerlIO_init(void) |
760ac839 LW |
466 | { |
467 | /* Does nothing (yet) except force this file to be included | |
468 | in perl binary. That allows this file to force inclusion | |
469 | of other functions that may be required by loadable | |
470 | extensions e.g. for FileHandle::tmpfile | |
471 | */ | |
472 | } | |
473 | ||
474 | #endif /* USE_SFIO */ | |
475 | #endif /* PERLIO_IS_STDIO */ | |
476 | ||
477 | #ifndef HAS_FSETPOS | |
478 | #undef PerlIO_setpos | |
479 | int | |
c78749f2 | 480 | PerlIO_setpos(PerlIO *f, const Fpos_t *pos) |
760ac839 LW |
481 | { |
482 | return PerlIO_seek(f,*pos,0); | |
483 | } | |
c411622e | 484 | #else |
485 | #ifndef PERLIO_IS_STDIO | |
486 | #undef PerlIO_setpos | |
487 | int | |
c78749f2 | 488 | PerlIO_setpos(PerlIO *f, const Fpos_t *pos) |
c411622e | 489 | { |
490 | return fsetpos(f, pos); | |
491 | } | |
492 | #endif | |
760ac839 LW |
493 | #endif |
494 | ||
495 | #ifndef HAS_FGETPOS | |
496 | #undef PerlIO_getpos | |
497 | int | |
c78749f2 | 498 | PerlIO_getpos(PerlIO *f, Fpos_t *pos) |
760ac839 LW |
499 | { |
500 | *pos = PerlIO_tell(f); | |
501 | return 0; | |
502 | } | |
c411622e | 503 | #else |
504 | #ifndef PERLIO_IS_STDIO | |
505 | #undef PerlIO_getpos | |
506 | int | |
c78749f2 | 507 | PerlIO_getpos(PerlIO *f, Fpos_t *pos) |
c411622e | 508 | { |
509 | return fgetpos(f, pos); | |
510 | } | |
511 | #endif | |
760ac839 LW |
512 | #endif |
513 | ||
514 | #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF) | |
515 | ||
516 | int | |
c78749f2 | 517 | vprintf(char *pat, char *args) |
662a7e3f CS |
518 | { |
519 | _doprnt(pat, args, stdout); | |
520 | return 0; /* wrong, but perl doesn't use the return value */ | |
521 | } | |
522 | ||
523 | int | |
c78749f2 | 524 | vfprintf(FILE *fd, char *pat, char *args) |
760ac839 LW |
525 | { |
526 | _doprnt(pat, args, fd); | |
527 | return 0; /* wrong, but perl doesn't use the return value */ | |
528 | } | |
529 | ||
530 | #endif | |
531 | ||
532 | #ifndef PerlIO_vsprintf | |
533 | int | |
8ac85365 | 534 | PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap) |
760ac839 LW |
535 | { |
536 | int val = vsprintf(s, fmt, ap); | |
537 | if (n >= 0) | |
538 | { | |
8c86a920 | 539 | if (strlen(s) >= (STRLEN)n) |
760ac839 LW |
540 | { |
541 | PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n"); | |
cea2e8a9 GS |
542 | { |
543 | dTHX; | |
544 | my_exit(1); | |
545 | } | |
760ac839 LW |
546 | } |
547 | } | |
548 | return val; | |
549 | } | |
550 | #endif | |
551 | ||
552 | #ifndef PerlIO_sprintf | |
553 | int | |
760ac839 | 554 | PerlIO_sprintf(char *s, int n, const char *fmt,...) |
760ac839 LW |
555 | { |
556 | va_list ap; | |
557 | int result; | |
760ac839 | 558 | va_start(ap,fmt); |
760ac839 LW |
559 | result = PerlIO_vsprintf(s, n, fmt, ap); |
560 | va_end(ap); | |
561 | return result; | |
562 | } | |
563 | #endif | |
564 | ||
c5be433b GS |
565 | #endif /* !PERL_IMPLICIT_SYS */ |
566 |