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