[differences between cumulative patch application and perl5.004_01]
[p5sagit/p5-mst-13.2.git] / perlio.c
CommitLineData
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
28void
29PerlIO_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
39PerlIO *
40PerlIO_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
57PerlIO *
58PerlIO_tmpfile()
59{
60 return sftmp(0);
61}
62
63void
64PerlIO_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
86PerlIO *
87PerlIO_stderr()
88{
89 return (PerlIO *) stderr;
90}
91
92#undef PerlIO_stdin
93PerlIO *
94PerlIO_stdin()
95{
96 return (PerlIO *) stdin;
97}
98
99#undef PerlIO_stdout
100PerlIO *
101PerlIO_stdout()
102{
103 return (PerlIO *) stdout;
104}
105
760ac839 106#undef PerlIO_fast_gets
107int
108PerlIO_fast_gets(f)
109PerlIO *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
119int
120PerlIO_has_cntptr(f)
121PerlIO *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
131int
132PerlIO_canset_cnt(f)
133PerlIO *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
143void
144PerlIO_set_cnt(f,cnt)
145PerlIO *f;
146int cnt;
147{
159bba36 148 if (cnt < -1)
760ac839 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
158void
159PerlIO_set_ptrcnt(f,ptr,cnt)
160PerlIO *f;
888911fc 161STDCHAR *ptr;
760ac839 162int cnt;
163{
33dcbb9a 164#ifdef FILE_bufsiz
888911fc 165 STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
166 int ec = e - ptr;
159bba36 167 if (ptr > e + 1)
168 warn("Setting ptr %p > end+1 %p\n", ptr, e + 1);
760ac839 169 if (cnt != ec)
170 warn("Setting cnt to %d, ptr implies %d\n",cnt,ec);
33dcbb9a 171#endif
760ac839 172#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
888911fc 173 FILE_ptr(f) = ptr;
760ac839 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
185int
186PerlIO_get_cnt(f)
187PerlIO *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
198int
199PerlIO_get_bufsiz(f)
200PerlIO *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
888911fc 211STDCHAR *
760ac839 212PerlIO_get_ptr(f)
213PerlIO *f;
214{
215#ifdef FILE_ptr
888911fc 216 return FILE_ptr(f);
760ac839 217#else
218 croak("Cannot get 'ptr' of FILE * on this system");
219 return NULL;
220#endif
221}
222
223#undef PerlIO_get_base
888911fc 224STDCHAR *
760ac839 225PerlIO_get_base(f)
226PerlIO *f;
227{
228#ifdef FILE_base
888911fc 229 return FILE_base(f);
760ac839 230#else
231 croak("Cannot get 'base' of FILE * on this system");
232 return NULL;
233#endif
234}
235
236#undef PerlIO_has_base
237int
238PerlIO_has_base(f)
239PerlIO *f;
240{
241#ifdef FILE_base
242 return 1;
243#else
244 return 0;
245#endif
246}
247
248#undef PerlIO_puts
249int
250PerlIO_puts(f,s)
251PerlIO *f;
252const char *s;
253{
254 return fputs(s,f);
255}
256
257#undef PerlIO_open
258PerlIO *
259PerlIO_open(path,mode)
260const char *path;
261const char *mode;
262{
263 return fopen(path,mode);
264}
265
266#undef PerlIO_fdopen
267PerlIO *
268PerlIO_fdopen(fd,mode)
269int fd;
270const char *mode;
271{
272 return fdopen(fd,mode);
273}
274
8c86a920 275#undef PerlIO_reopen
276PerlIO *
111c4dfa 277PerlIO_reopen(name, mode, f)
278const char *name;
8c86a920 279const char *mode;
111c4dfa 280PerlIO *f;
8c86a920 281{
282 return freopen(name,mode,f);
283}
760ac839 284
285#undef PerlIO_close
286int
287PerlIO_close(f)
288PerlIO *f;
289{
290 return fclose(f);
291}
292
293#undef PerlIO_eof
294int
295PerlIO_eof(f)
296PerlIO *f;
297{
298 return feof(f);
299}
300
8c86a920 301#undef PerlIO_getname
302char *
303PerlIO_getname(f,buf)
304PerlIO *f;
305char *buf;
306{
307#ifdef VMS
308 return fgetname(f,buf);
309#else
310 croak("Don't know how to get file name");
c64afb19 311 return NULL;
8c86a920 312#endif
313}
314
760ac839 315#undef PerlIO_getc
316int
317PerlIO_getc(f)
318PerlIO *f;
319{
320 return fgetc(f);
321}
322
323#undef PerlIO_error
324int
325PerlIO_error(f)
326PerlIO *f;
327{
328 return ferror(f);
329}
330
331#undef PerlIO_clearerr
332void
333PerlIO_clearerr(f)
334PerlIO *f;
335{
336 clearerr(f);
337}
338
339#undef PerlIO_flush
340int
341PerlIO_flush(f)
342PerlIO *f;
343{
344 return Fflush(f);
345}
346
347#undef PerlIO_fileno
348int
349PerlIO_fileno(f)
350PerlIO *f;
351{
352 return fileno(f);
353}
354
355#undef PerlIO_setlinebuf
356void
357PerlIO_setlinebuf(f)
358PerlIO *f;
359{
360#ifdef HAS_SETLINEBUF
361 setlinebuf(f);
362#else
3e3baf6d 363# ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */
364 setvbuf(f, Nullch, _IOLBF, BUFSIZ);
365# else
760ac839 366 setvbuf(f, Nullch, _IOLBF, 0);
3e3baf6d 367# endif
760ac839 368#endif
369}
370
371#undef PerlIO_putc
372int
373PerlIO_putc(f,ch)
374PerlIO *f;
375int ch;
376{
9010f3dd 377 return putc(ch,f);
760ac839 378}
379
380#undef PerlIO_ungetc
381int
382PerlIO_ungetc(f,ch)
383PerlIO *f;
384int ch;
385{
9010f3dd 386 return ungetc(ch,f);
760ac839 387}
388
389#undef PerlIO_read
5b54f415 390SSize_t
760ac839 391PerlIO_read(f,buf,count)
392PerlIO *f;
393void *buf;
5b54f415 394Size_t count;
760ac839 395{
396 return fread(buf,1,count,f);
397}
398
399#undef PerlIO_write
5b54f415 400SSize_t
760ac839 401PerlIO_write(f,buf,count)
402PerlIO *f;
403const void *buf;
5b54f415 404Size_t count;
760ac839 405{
406 return fwrite1(buf,1,count,f);
407}
408
409#undef PerlIO_vprintf
410int
411PerlIO_vprintf(f,fmt,ap)
412PerlIO *f;
413const char *fmt;
414va_list ap;
415{
416 return vfprintf(f,fmt,ap);
417}
418
419
420#undef PerlIO_tell
421long
422PerlIO_tell(f)
423PerlIO *f;
424{
425 return ftell(f);
426}
427
428#undef PerlIO_seek
429int
430PerlIO_seek(f,offset,whence)
431PerlIO *f;
432off_t offset;
433int whence;
434{
435 return fseek(f,offset,whence);
436}
437
438#undef PerlIO_rewind
439void
440PerlIO_rewind(f)
441PerlIO *f;
442{
443 rewind(f);
444}
445
446#undef PerlIO_printf
447int
448#ifdef I_STDARG
449PerlIO_printf(PerlIO *f,const char *fmt,...)
450#else
451PerlIO_printf(f,fmt,va_alist)
452PerlIO *f;
453const char *fmt;
454va_dcl
455#endif
456{
457 va_list ap;
458 int result;
459#ifdef I_STDARG
460 va_start(ap,fmt);
461#else
462 va_start(ap);
463#endif
464 result = vfprintf(f,fmt,ap);
465 va_end(ap);
466 return result;
467}
468
469#undef PerlIO_stdoutf
470int
471#ifdef I_STDARG
472PerlIO_stdoutf(const char *fmt,...)
473#else
474PerlIO_stdoutf(fmt, va_alist)
475const char *fmt;
476va_dcl
477#endif
478{
479 va_list ap;
480 int result;
481#ifdef I_STDARG
482 va_start(ap,fmt);
483#else
484 va_start(ap);
485#endif
486 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
487 va_end(ap);
488 return result;
489}
490
491#undef PerlIO_tmpfile
492PerlIO *
493PerlIO_tmpfile()
494{
495 return tmpfile();
496}
497
498#undef PerlIO_importFILE
499PerlIO *
500PerlIO_importFILE(f,fl)
501FILE *f;
502int fl;
503{
504 return f;
505}
506
507#undef PerlIO_exportFILE
508FILE *
509PerlIO_exportFILE(f,fl)
510PerlIO *f;
511int fl;
512{
513 return f;
514}
515
516#undef PerlIO_findFILE
517FILE *
518PerlIO_findFILE(f)
519PerlIO *f;
520{
521 return f;
522}
523
524#undef PerlIO_releaseFILE
525void
526PerlIO_releaseFILE(p,f)
527PerlIO *p;
528FILE *f;
529{
530}
531
532void
533PerlIO_init()
534{
535 /* Does nothing (yet) except force this file to be included
536 in perl binary. That allows this file to force inclusion
537 of other functions that may be required by loadable
538 extensions e.g. for FileHandle::tmpfile
539 */
540}
541
542#endif /* USE_SFIO */
543#endif /* PERLIO_IS_STDIO */
544
545#ifndef HAS_FSETPOS
546#undef PerlIO_setpos
547int
548PerlIO_setpos(f,pos)
549PerlIO *f;
550const Fpos_t *pos;
551{
552 return PerlIO_seek(f,*pos,0);
553}
c411622e 554#else
555#ifndef PERLIO_IS_STDIO
556#undef PerlIO_setpos
557int
558PerlIO_setpos(f,pos)
559PerlIO *f;
560const Fpos_t *pos;
561{
562 return fsetpos(f, pos);
563}
564#endif
760ac839 565#endif
566
567#ifndef HAS_FGETPOS
568#undef PerlIO_getpos
569int
570PerlIO_getpos(f,pos)
571PerlIO *f;
572Fpos_t *pos;
573{
574 *pos = PerlIO_tell(f);
575 return 0;
576}
c411622e 577#else
578#ifndef PERLIO_IS_STDIO
579#undef PerlIO_getpos
580int
581PerlIO_getpos(f,pos)
582PerlIO *f;
583Fpos_t *pos;
584{
585 return fgetpos(f, pos);
586}
587#endif
760ac839 588#endif
589
590#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
591
592int
662a7e3f 593vprintf(pat, args)
594char *pat, *args;
595{
596 _doprnt(pat, args, stdout);
597 return 0; /* wrong, but perl doesn't use the return value */
598}
599
600int
601vfprintf(fd, pat, args)
760ac839 602FILE *fd;
603char *pat, *args;
604{
605 _doprnt(pat, args, fd);
606 return 0; /* wrong, but perl doesn't use the return value */
607}
608
609#endif
610
611#ifndef PerlIO_vsprintf
612int
613PerlIO_vsprintf(s,n,fmt,ap)
614char *s;
615const char *fmt;
616int n;
617va_list ap;
618{
619 int val = vsprintf(s, fmt, ap);
620 if (n >= 0)
621 {
8c86a920 622 if (strlen(s) >= (STRLEN)n)
760ac839 623 {
624 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
625 my_exit(1);
626 }
627 }
628 return val;
629}
630#endif
631
632#ifndef PerlIO_sprintf
633int
634#ifdef I_STDARG
635PerlIO_sprintf(char *s, int n, const char *fmt,...)
636#else
637PerlIO_sprintf(s, n, fmt, va_alist)
638char *s;
639int n;
640const char *fmt;
641va_dcl
642#endif
643{
644 va_list ap;
645 int result;
646#ifdef I_STDARG
647 va_start(ap,fmt);
648#else
649 va_start(ap);
650#endif
651 result = PerlIO_vsprintf(s, n, fmt, ap);
652 va_end(ap);
653 return result;
654}
655#endif
656