[inseparable changes from match from perl-5.003_93 to perl-5.003_94]
[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");
311#endif
312}
313
760ac839 314#undef PerlIO_getc
315int
316PerlIO_getc(f)
317PerlIO *f;
318{
319 return fgetc(f);
320}
321
322#undef PerlIO_error
323int
324PerlIO_error(f)
325PerlIO *f;
326{
327 return ferror(f);
328}
329
330#undef PerlIO_clearerr
331void
332PerlIO_clearerr(f)
333PerlIO *f;
334{
335 clearerr(f);
336}
337
338#undef PerlIO_flush
339int
340PerlIO_flush(f)
341PerlIO *f;
342{
343 return Fflush(f);
344}
345
346#undef PerlIO_fileno
347int
348PerlIO_fileno(f)
349PerlIO *f;
350{
351 return fileno(f);
352}
353
354#undef PerlIO_setlinebuf
355void
356PerlIO_setlinebuf(f)
357PerlIO *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
367int
368PerlIO_putc(f,ch)
369PerlIO *f;
370int ch;
371{
372 putc(ch,f);
373}
374
375#undef PerlIO_ungetc
376int
377PerlIO_ungetc(f,ch)
378PerlIO *f;
379int ch;
380{
381 ungetc(ch,f);
382}
383
384#undef PerlIO_read
385int
386PerlIO_read(f,buf,count)
387PerlIO *f;
388void *buf;
389size_t count;
390{
391 return fread(buf,1,count,f);
392}
393
394#undef PerlIO_write
395int
396PerlIO_write(f,buf,count)
397PerlIO *f;
398const void *buf;
399size_t count;
400{
401 return fwrite1(buf,1,count,f);
402}
403
404#undef PerlIO_vprintf
405int
406PerlIO_vprintf(f,fmt,ap)
407PerlIO *f;
408const char *fmt;
409va_list ap;
410{
411 return vfprintf(f,fmt,ap);
412}
413
414
415#undef PerlIO_tell
416long
417PerlIO_tell(f)
418PerlIO *f;
419{
420 return ftell(f);
421}
422
423#undef PerlIO_seek
424int
425PerlIO_seek(f,offset,whence)
426PerlIO *f;
427off_t offset;
428int whence;
429{
430 return fseek(f,offset,whence);
431}
432
433#undef PerlIO_rewind
434void
435PerlIO_rewind(f)
436PerlIO *f;
437{
438 rewind(f);
439}
440
441#undef PerlIO_printf
442int
443#ifdef I_STDARG
444PerlIO_printf(PerlIO *f,const char *fmt,...)
445#else
446PerlIO_printf(f,fmt,va_alist)
447PerlIO *f;
448const char *fmt;
449va_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
465int
466#ifdef I_STDARG
467PerlIO_stdoutf(const char *fmt,...)
468#else
469PerlIO_stdoutf(fmt, va_alist)
470const char *fmt;
471va_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
487PerlIO *
488PerlIO_tmpfile()
489{
490 return tmpfile();
491}
492
493#undef PerlIO_importFILE
494PerlIO *
495PerlIO_importFILE(f,fl)
496FILE *f;
497int fl;
498{
499 return f;
500}
501
502#undef PerlIO_exportFILE
503FILE *
504PerlIO_exportFILE(f,fl)
505PerlIO *f;
506int fl;
507{
508 return f;
509}
510
511#undef PerlIO_findFILE
512FILE *
513PerlIO_findFILE(f)
514PerlIO *f;
515{
516 return f;
517}
518
519#undef PerlIO_releaseFILE
520void
521PerlIO_releaseFILE(p,f)
522PerlIO *p;
523FILE *f;
524{
525}
526
527void
528PerlIO_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
542int
543PerlIO_setpos(f,pos)
544PerlIO *f;
545const Fpos_t *pos;
546{
547 return PerlIO_seek(f,*pos,0);
548}
c411622e 549#else
550#ifndef PERLIO_IS_STDIO
551#undef PerlIO_setpos
552int
553PerlIO_setpos(f,pos)
554PerlIO *f;
555const Fpos_t *pos;
556{
557 return fsetpos(f, pos);
558}
559#endif
760ac839 560#endif
561
562#ifndef HAS_FGETPOS
563#undef PerlIO_getpos
564int
565PerlIO_getpos(f,pos)
566PerlIO *f;
567Fpos_t *pos;
568{
569 *pos = PerlIO_tell(f);
570 return 0;
571}
c411622e 572#else
573#ifndef PERLIO_IS_STDIO
574#undef PerlIO_getpos
575int
576PerlIO_getpos(f,pos)
577PerlIO *f;
578Fpos_t *pos;
579{
580 return fgetpos(f, pos);
581}
582#endif
760ac839 583#endif
584
585#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
586
587int
588vprintf(fd, pat, args)
589FILE *fd;
590char *pat, *args;
591{
592 _doprnt(pat, args, fd);
593 return 0; /* wrong, but perl doesn't use the return value */
594}
595
596#endif
597
598#ifndef PerlIO_vsprintf
599int
600PerlIO_vsprintf(s,n,fmt,ap)
601char *s;
602const char *fmt;
603int n;
604va_list ap;
605{
606 int val = vsprintf(s, fmt, ap);
607 if (n >= 0)
608 {
8c86a920 609 if (strlen(s) >= (STRLEN)n)
760ac839 610 {
611 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
612 my_exit(1);
613 }
614 }
615 return val;
616}
617#endif
618
619#ifndef PerlIO_sprintf
620int
621#ifdef I_STDARG
622PerlIO_sprintf(char *s, int n, const char *fmt,...)
623#else
624PerlIO_sprintf(s, n, fmt, va_alist)
625char *s;
626int n;
627const char *fmt;
628va_dcl
629#endif
630{
631 va_list ap;
632 int result;
633#ifdef I_STDARG
634 va_start(ap,fmt);
635#else
636 va_start(ap);
637#endif
638 result = PerlIO_vsprintf(s, n, fmt, ap);
639 va_end(ap);
640 return result;
641}
642#endif
643