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