This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bump patchlevel to 52; other little tweaks for threads, win32 builds
[perl5.git] / perlio.c
CommitLineData
760ac839
LW
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
0f4eea8f 19 * which are not #defined in iperlsys.h.
760ac839
LW
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
8ac85365 29PerlIO_init(void)
760ac839
LW
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
PP
38#undef PerlIO_tmpfile
39PerlIO *
8ac85365 40PerlIO_tmpfile(void)
33dcbb9a
PP
41{
42 return tmpfile();
43}
44
760ac839
LW
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
17c3b450 79#else /* USE_SFIO */
760ac839
LW
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
LW
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
LW
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
LW
162int cnt;
163{
33dcbb9a 164#ifdef FILE_bufsiz
888911fc
CS
165 STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
166 int ec = e - ptr;
159bba36
CS
167 if (ptr > e + 1)
168 warn("Setting ptr %p > end+1 %p\n", ptr, e + 1);
760ac839
LW
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
LW
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
LW
212PerlIO_get_ptr(f)
213PerlIO *f;
214{
215#ifdef FILE_ptr
888911fc 216 return FILE_ptr(f);
760ac839
LW
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
LW
225PerlIO_get_base(f)
226PerlIO *f;
227{
228#ifdef FILE_base
888911fc 229 return FILE_base(f);
760ac839
LW
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
PP
275#undef PerlIO_reopen
276PerlIO *
111c4dfa
HK
277PerlIO_reopen(name, mode, f)
278const char *name;
8c86a920 279const char *mode;
111c4dfa 280PerlIO *f;
8c86a920
PP
281{
282 return freopen(name,mode,f);
283}
760ac839
LW
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
PP
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
PP
312#endif
313}
314
760ac839
LW
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
TB
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
LW
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
LW
378}
379
380#undef PerlIO_ungetc
381int
382PerlIO_ungetc(f,ch)
383PerlIO *f;
384int ch;
385{
9010f3dd 386 return ungetc(ch,f);
760ac839
LW
387}
388
389#undef PerlIO_read
5b54f415 390SSize_t
760ac839
LW
391PerlIO_read(f,buf,count)
392PerlIO *f;
393void *buf;
5b54f415 394Size_t count;
760ac839
LW
395{
396 return fread(buf,1,count,f);
397}
398
399#undef PerlIO_write
5b54f415 400SSize_t
760ac839
LW
401PerlIO_write(f,buf,count)
402PerlIO *f;
403const void *buf;
5b54f415 404Size_t count;
760ac839
LW
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
760ac839 448PerlIO_printf(PerlIO *f,const char *fmt,...)
760ac839
LW
449{
450 va_list ap;
451 int result;
760ac839 452 va_start(ap,fmt);
760ac839
LW
453 result = vfprintf(f,fmt,ap);
454 va_end(ap);
455 return result;
456}
457
458#undef PerlIO_stdoutf
459int
760ac839 460PerlIO_stdoutf(const char *fmt,...)
760ac839
LW
461{
462 va_list ap;
463 int result;
760ac839 464 va_start(ap,fmt);
760ac839
LW
465 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
466 va_end(ap);
467 return result;
468}
469
470#undef PerlIO_tmpfile
471PerlIO *
472PerlIO_tmpfile()
473{
474 return tmpfile();
475}
476
477#undef PerlIO_importFILE
478PerlIO *
479PerlIO_importFILE(f,fl)
480FILE *f;
481int fl;
482{
483 return f;
484}
485
486#undef PerlIO_exportFILE
487FILE *
488PerlIO_exportFILE(f,fl)
489PerlIO *f;
490int fl;
491{
492 return f;
493}
494
495#undef PerlIO_findFILE
496FILE *
497PerlIO_findFILE(f)
498PerlIO *f;
499{
500 return f;
501}
502
503#undef PerlIO_releaseFILE
504void
505PerlIO_releaseFILE(p,f)
506PerlIO *p;
507FILE *f;
508{
509}
510
511void
512PerlIO_init()
513{
514 /* Does nothing (yet) except force this file to be included
515 in perl binary. That allows this file to force inclusion
516 of other functions that may be required by loadable
517 extensions e.g. for FileHandle::tmpfile
518 */
519}
520
521#endif /* USE_SFIO */
522#endif /* PERLIO_IS_STDIO */
523
524#ifndef HAS_FSETPOS
525#undef PerlIO_setpos
526int
527PerlIO_setpos(f,pos)
528PerlIO *f;
529const Fpos_t *pos;
530{
531 return PerlIO_seek(f,*pos,0);
532}
c411622e
PP
533#else
534#ifndef PERLIO_IS_STDIO
535#undef PerlIO_setpos
536int
537PerlIO_setpos(f,pos)
538PerlIO *f;
539const Fpos_t *pos;
540{
541 return fsetpos(f, pos);
542}
543#endif
760ac839
LW
544#endif
545
546#ifndef HAS_FGETPOS
547#undef PerlIO_getpos
548int
549PerlIO_getpos(f,pos)
550PerlIO *f;
551Fpos_t *pos;
552{
553 *pos = PerlIO_tell(f);
554 return 0;
555}
c411622e
PP
556#else
557#ifndef PERLIO_IS_STDIO
558#undef PerlIO_getpos
559int
560PerlIO_getpos(f,pos)
561PerlIO *f;
562Fpos_t *pos;
563{
564 return fgetpos(f, pos);
565}
566#endif
760ac839
LW
567#endif
568
569#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
570
571int
662a7e3f
CS
572vprintf(pat, args)
573char *pat, *args;
574{
575 _doprnt(pat, args, stdout);
576 return 0; /* wrong, but perl doesn't use the return value */
577}
578
579int
580vfprintf(fd, pat, args)
760ac839
LW
581FILE *fd;
582char *pat, *args;
583{
584 _doprnt(pat, args, fd);
585 return 0; /* wrong, but perl doesn't use the return value */
586}
587
588#endif
589
590#ifndef PerlIO_vsprintf
591int
8ac85365 592PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
760ac839
LW
593{
594 int val = vsprintf(s, fmt, ap);
595 if (n >= 0)
596 {
8c86a920 597 if (strlen(s) >= (STRLEN)n)
760ac839
LW
598 {
599 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
600 my_exit(1);
601 }
602 }
603 return val;
604}
605#endif
606
607#ifndef PerlIO_sprintf
608int
760ac839 609PerlIO_sprintf(char *s, int n, const char *fmt,...)
760ac839
LW
610{
611 va_list ap;
612 int result;
760ac839 613 va_start(ap,fmt);
760ac839
LW
614 result = PerlIO_vsprintf(s, n, fmt, ap);
615 va_end(ap);
616 return result;
617}
618#endif
619