This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix warning from missing POSIX::setvbuf()
[perl5.git] / ext / IO / IO.xs
1 #include "EXTERN.h"
2 #define PERLIO_NOT_STDIO 1
3 #include "perl.h"
4 #include "XSUB.h"
5
6 #ifdef I_UNISTD
7 #  include <unistd.h>
8 #endif
9 #ifdef I_FCNTL
10 #  include <fcntl.h>
11 #endif
12
13 #ifdef PerlIO
14 typedef int SysRet;
15 typedef PerlIO * InputStream;
16 typedef PerlIO * OutputStream;
17 #else
18 #define PERLIO_IS_STDIO 1
19 typedef int SysRet;
20 typedef FILE * InputStream;
21 typedef FILE * OutputStream;
22 #endif
23
24 static int
25 not_here(s)
26 char *s;
27 {
28     croak("%s not implemented on this architecture", s);
29     return -1;
30 }
31
32 static bool
33 constant(name, pval)
34 char *name;
35 IV *pval;
36 {
37     switch (*name) {
38     case '_':
39         if (strEQ(name, "_IOFBF"))
40 #ifdef _IOFBF
41             { *pval = _IOFBF; return TRUE; }
42 #else
43             return FALSE;
44 #endif
45         if (strEQ(name, "_IOLBF"))
46 #ifdef _IOLBF
47             { *pval = _IOLBF; return TRUE; }
48 #else
49             return FALSE;
50 #endif
51         if (strEQ(name, "_IONBF"))
52 #ifdef _IONBF
53             { *pval = _IONBF; return TRUE; }
54 #else
55             return FALSE;
56 #endif
57         break;
58     case 'S':
59         if (strEQ(name, "SEEK_SET"))
60 #ifdef SEEK_SET
61             { *pval = SEEK_SET; return TRUE; }
62 #else
63             return FALSE;
64 #endif
65         if (strEQ(name, "SEEK_CUR"))
66 #ifdef SEEK_CUR
67             { *pval = SEEK_CUR; return TRUE; }
68 #else
69             return FALSE;
70 #endif
71         if (strEQ(name, "SEEK_END"))
72 #ifdef SEEK_END
73             { *pval = SEEK_END; return TRUE; }
74 #else
75             return FALSE;
76 #endif
77         break;
78     }
79
80     return FALSE;
81 }
82
83
84 MODULE = IO     PACKAGE = IO::Seekable  PREFIX = f
85
86 SV *
87 fgetpos(handle)
88         InputStream     handle
89     CODE:
90         if (handle) {
91             Fpos_t pos;
92 #ifdef PerlIO
93             PerlIO_getpos(handle, &pos);
94 #else
95             fgetpos(handle, &pos);
96 #endif
97             ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
98         }
99         else {
100             ST(0) = &sv_undef;
101             errno = EINVAL;
102         }
103
104 SysRet
105 fsetpos(handle, pos)
106         InputStream     handle
107         SV *            pos
108     CODE:
109         if (handle)
110 #ifdef PerlIO
111             RETVAL = PerlIO_setpos(handle, (Fpos_t*)SvPVX(pos));
112 #else
113             RETVAL = fsetpos(handle, (Fpos_t*)SvPVX(pos));
114 #endif
115         else {
116             RETVAL = -1;
117             errno = EINVAL;
118         }
119     OUTPUT:
120         RETVAL
121
122 MODULE = IO     PACKAGE = IO::File      PREFIX = f
123
124 SV *
125 new_tmpfile(packname = "IO::File")
126     char *              packname
127     PREINIT:
128         OutputStream fp;
129         GV *gv;
130     CODE:
131 #ifdef PerlIO
132         fp = PerlIO_tmpfile();
133 #else
134         fp = tmpfile();
135 #endif
136         gv = (GV*)SvREFCNT_inc(newGVgen(packname));
137         hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
138         if (do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) {
139             ST(0) = sv_2mortal(newRV((SV*)gv));
140             sv_bless(ST(0), gv_stashpv(packname, TRUE));
141             SvREFCNT_dec(gv);   /* undo increment in newRV() */
142         }
143         else {
144             ST(0) = &sv_undef;
145             SvREFCNT_dec(gv);
146         }
147
148 MODULE = IO     PACKAGE = IO::Handle    PREFIX = f
149
150 SV *
151 constant(name)
152         char *          name
153     CODE:
154         IV i;
155         if (constant(name, &i))
156             ST(0) = sv_2mortal(newSViv(i));
157         else
158             ST(0) = &sv_undef;
159
160 int
161 ungetc(handle, c)
162         InputStream     handle
163         int             c
164     CODE:
165         if (handle)
166 #ifdef PerlIO
167             RETVAL = PerlIO_ungetc(handle, c);
168 #else
169             RETVAL = ungetc(c, handle);
170 #endif
171         else {
172             RETVAL = -1;
173             errno = EINVAL;
174         }
175     OUTPUT:
176         RETVAL
177
178 int
179 ferror(handle)
180         InputStream     handle
181     CODE:
182         if (handle)
183 #ifdef PerlIO
184             RETVAL = PerlIO_error(handle);
185 #else
186             RETVAL = ferror(handle);
187 #endif
188         else {
189             RETVAL = -1;
190             errno = EINVAL;
191         }
192     OUTPUT:
193         RETVAL
194
195 int
196 clearerr(handle)
197         InputStream     handle
198     CODE:
199         if (handle) {
200 #ifdef PerlIO
201             PerlIO_clearerr(handle);
202 #else
203             clearerr(handle);
204 #endif
205             RETVAL = 0;
206         }
207         else {
208             RETVAL = -1;
209             errno = EINVAL;
210         }
211     OUTPUT:
212         RETVAL
213
214 int
215 untaint(handle)
216        SV *     handle
217     CODE:
218 #ifdef IOf_UNTAINT
219         IO * io;
220         io = sv_2io(handle);
221         if (io) {
222             IoFLAGS(io) |= IOf_UNTAINT;
223             RETVAL = 0;
224         }
225         else {
226 #endif
227             RETVAL = -1;
228             errno = EINVAL;
229 #ifdef IOf_UNTAINT
230         }
231 #endif
232     OUTPUT:
233         RETVAL
234
235 SysRet
236 fflush(handle)
237         OutputStream    handle
238     CODE:
239         if (handle)
240 #ifdef PerlIO
241             RETVAL = PerlIO_flush(handle);
242 #else
243             RETVAL = Fflush(handle);
244 #endif
245         else {
246             RETVAL = -1;
247             errno = EINVAL;
248         }
249     OUTPUT:
250         RETVAL
251
252 void
253 setbuf(handle, buf)
254         OutputStream    handle
255         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
256     CODE:
257         if (handle)
258 #ifdef PERLIO_IS_STDIO
259             setbuf(handle, buf);
260 #else
261             not_here("IO::Handle::setbuf");
262 #endif
263
264 SysRet
265 setvbuf(handle, buf, type, size)
266         OutputStream    handle
267         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
268         int             type
269         int             size
270     CODE:
271 /* Should check HAS_SETVBUF once Configure tests for that */
272 #if defined(PERLIO_IS_STDIO) && defined(_IOFBF)
273         if (handle)
274             RETVAL = setvbuf(handle, buf, type, size);
275         else {
276             RETVAL = -1;
277             errno = EINVAL;
278         }
279 #else
280         RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
281 #endif
282     OUTPUT:
283         RETVAL
284
285