perl 5.003_03: perl.h
[perl.git] / perlio.c
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