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