Don't use $4 when it might be undef
[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 #undef PerlIO_tmpfile
39 PerlIO *
40 PerlIO_tmpfile()
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()
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 #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 < -1)
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 STDCHAR *ptr;
162 int cnt;
163 {
164 #ifdef FILE_bufsiz
165  STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
166  int ec = e - ptr;
167  if (ptr > e + 1)
168   warn("Setting ptr %p > end+1 %p\n", ptr, e + 1);
169  if (cnt != ec)
170   warn("Setting cnt to %d, ptr implies %d\n",cnt,ec);
171 #endif
172 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
173  FILE_ptr(f) = 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 STDCHAR *
212 PerlIO_get_ptr(f)
213 PerlIO *f;
214 {
215 #ifdef FILE_ptr
216  return 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 STDCHAR *
225 PerlIO_get_base(f)
226 PerlIO *f;
227 {
228 #ifdef FILE_base
229  return 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 #undef PerlIO_reopen
276 PerlIO * 
277 PerlIO_reopen(name, mode, f)
278 const char *name;
279 const char *mode;
280 PerlIO *f;
281 {
282  return freopen(name,mode,f);
283 }
284
285 #undef PerlIO_close
286 int      
287 PerlIO_close(f)
288 PerlIO *f;
289 {
290  return fclose(f);
291 }
292
293 #undef PerlIO_eof
294 int      
295 PerlIO_eof(f)
296 PerlIO *f;
297 {
298  return feof(f);
299 }
300
301 #undef PerlIO_getname
302 char *
303 PerlIO_getname(f,buf)
304 PerlIO *f;
305 char *buf;
306 {
307 #ifdef VMS
308  return fgetname(f,buf);
309 #else
310  croak("Don't know how to get file name");
311 #endif
312 }
313
314 #undef PerlIO_getc
315 int      
316 PerlIO_getc(f)
317 PerlIO *f;
318 {
319  return fgetc(f);
320 }
321
322 #undef PerlIO_error
323 int      
324 PerlIO_error(f)
325 PerlIO *f;
326 {
327  return ferror(f);
328 }
329
330 #undef PerlIO_clearerr
331 void
332 PerlIO_clearerr(f)
333 PerlIO *f;
334 {
335  clearerr(f);
336 }
337
338 #undef PerlIO_flush
339 int      
340 PerlIO_flush(f)
341 PerlIO *f;
342 {
343  return Fflush(f);
344 }
345
346 #undef PerlIO_fileno
347 int      
348 PerlIO_fileno(f)
349 PerlIO *f;
350 {
351  return fileno(f);
352 }
353
354 #undef PerlIO_setlinebuf
355 void
356 PerlIO_setlinebuf(f)
357 PerlIO *f;
358 {
359 #ifdef HAS_SETLINEBUF
360     setlinebuf(f);
361 #else
362     setvbuf(f, Nullch, _IOLBF, 0);
363 #endif
364 }
365
366 #undef PerlIO_putc
367 int      
368 PerlIO_putc(f,ch)
369 PerlIO *f;
370 int ch;
371 {
372  putc(ch,f);
373 }
374
375 #undef PerlIO_ungetc
376 int      
377 PerlIO_ungetc(f,ch)
378 PerlIO *f;
379 int ch;
380 {
381  ungetc(ch,f);
382 }
383
384 #undef PerlIO_read
385 int      
386 PerlIO_read(f,buf,count)
387 PerlIO *f;
388 void *buf;
389 size_t count;
390 {
391  return fread(buf,1,count,f);
392 }
393
394 #undef PerlIO_write
395 int      
396 PerlIO_write(f,buf,count)
397 PerlIO *f;
398 const void *buf;
399 size_t count;
400 {
401  return fwrite1(buf,1,count,f);
402 }
403
404 #undef PerlIO_vprintf
405 int      
406 PerlIO_vprintf(f,fmt,ap)
407 PerlIO *f;
408 const char *fmt;
409 va_list ap;
410 {
411  return vfprintf(f,fmt,ap);
412 }
413
414
415 #undef PerlIO_tell
416 long
417 PerlIO_tell(f)
418 PerlIO *f;
419 {
420  return ftell(f);
421 }
422
423 #undef PerlIO_seek
424 int
425 PerlIO_seek(f,offset,whence)
426 PerlIO *f;
427 off_t offset;
428 int whence;
429 {
430  return fseek(f,offset,whence);
431 }
432
433 #undef PerlIO_rewind
434 void
435 PerlIO_rewind(f)
436 PerlIO *f;
437 {
438  rewind(f);
439 }
440
441 #undef PerlIO_printf
442 int      
443 #ifdef I_STDARG
444 PerlIO_printf(PerlIO *f,const char *fmt,...)
445 #else
446 PerlIO_printf(f,fmt,va_alist)
447 PerlIO *f;
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 = vfprintf(f,fmt,ap);
460  va_end(ap);
461  return result;
462 }
463
464 #undef PerlIO_stdoutf
465 int      
466 #ifdef I_STDARG
467 PerlIO_stdoutf(const char *fmt,...)
468 #else
469 PerlIO_stdoutf(fmt, va_alist)
470 const char *fmt;
471 va_dcl
472 #endif
473 {
474  va_list ap;
475  int result;
476 #ifdef I_STDARG
477  va_start(ap,fmt);
478 #else
479  va_start(ap);
480 #endif
481  result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
482  va_end(ap);
483  return result;
484 }
485
486 #undef PerlIO_tmpfile
487 PerlIO *
488 PerlIO_tmpfile()
489 {
490  return tmpfile();
491 }
492
493 #undef PerlIO_importFILE
494 PerlIO *
495 PerlIO_importFILE(f,fl)
496 FILE *f;
497 int fl;
498 {
499  return f;
500 }
501
502 #undef PerlIO_exportFILE
503 FILE *
504 PerlIO_exportFILE(f,fl)
505 PerlIO *f;
506 int fl;
507 {
508  return f;
509 }
510
511 #undef PerlIO_findFILE
512 FILE *
513 PerlIO_findFILE(f)
514 PerlIO *f;
515 {
516  return f;
517 }
518
519 #undef PerlIO_releaseFILE
520 void
521 PerlIO_releaseFILE(p,f)
522 PerlIO *p;
523 FILE *f;
524 {
525 }
526
527 void
528 PerlIO_init()
529 {
530  /* Does nothing (yet) except force this file to be included 
531     in perl binary. That allows this file to force inclusion
532     of other functions that may be required by loadable 
533     extensions e.g. for FileHandle::tmpfile  
534  */
535 }
536
537 #endif /* USE_SFIO */
538 #endif /* PERLIO_IS_STDIO */
539
540 #ifndef HAS_FSETPOS
541 #undef PerlIO_setpos
542 int
543 PerlIO_setpos(f,pos)
544 PerlIO *f;
545 const Fpos_t *pos;
546 {
547  return PerlIO_seek(f,*pos,0); 
548 }
549 #else
550 #ifndef PERLIO_IS_STDIO
551 #undef PerlIO_setpos
552 int
553 PerlIO_setpos(f,pos)
554 PerlIO *f;
555 const Fpos_t *pos;
556 {
557  return fsetpos(f, pos);
558 }
559 #endif
560 #endif
561
562 #ifndef HAS_FGETPOS
563 #undef PerlIO_getpos
564 int
565 PerlIO_getpos(f,pos)
566 PerlIO *f;
567 Fpos_t *pos;
568 {
569  *pos = PerlIO_tell(f);
570  return 0;
571 }
572 #else
573 #ifndef PERLIO_IS_STDIO
574 #undef PerlIO_getpos
575 int
576 PerlIO_getpos(f,pos)
577 PerlIO *f;
578 Fpos_t *pos;
579 {
580  return fgetpos(f, pos);
581 }
582 #endif
583 #endif
584
585 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
586
587 int
588 vprintf(pat, args)
589 char *pat, *args;
590 {
591     _doprnt(pat, args, stdout);
592     return 0;           /* wrong, but perl doesn't use the return value */
593 }
594
595 int
596 vfprintf(fd, pat, args)
597 FILE *fd;
598 char *pat, *args;
599 {
600     _doprnt(pat, args, fd);
601     return 0;           /* wrong, but perl doesn't use the return value */
602 }
603
604 #endif
605
606 #ifndef PerlIO_vsprintf
607 int 
608 PerlIO_vsprintf(s,n,fmt,ap)
609 char *s;
610 const char *fmt;
611 int n;
612 va_list ap;
613 {
614  int val = vsprintf(s, fmt, ap);
615  if (n >= 0)
616   {
617    if (strlen(s) >= (STRLEN)n)
618     {
619      PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
620      my_exit(1);
621     }
622   }
623  return val;
624 }
625 #endif
626
627 #ifndef PerlIO_sprintf
628 int      
629 #ifdef I_STDARG
630 PerlIO_sprintf(char *s, int n, const char *fmt,...)
631 #else
632 PerlIO_sprintf(s, n, fmt, va_alist)
633 char *s;
634 int n;
635 const char *fmt;
636 va_dcl
637 #endif
638 {
639  va_list ap;
640  int result;
641 #ifdef I_STDARG
642  va_start(ap,fmt);
643 #else
644  va_start(ap);
645 #endif
646  result = PerlIO_vsprintf(s, n, fmt, ap);
647  va_end(ap);
648  return result;
649 }
650 #endif
651