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