This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix core dump on IO::Seekable::setpos($fh, undef)
[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         char *p;
110         if (handle && (p = SvPVx(pos, na)) && na == sizeof(Fpos_t))
111 #ifdef PerlIO
112             RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
113 #else
114             RETVAL = fsetpos(handle, (Fpos_t*)p);
115 #endif
116         else {
117             RETVAL = -1;
118             errno = EINVAL;
119         }
120     OUTPUT:
121         RETVAL
122
123 MODULE = IO     PACKAGE = IO::File      PREFIX = f
124
125 SV *
126 new_tmpfile(packname = "IO::File")
127     char *              packname
128     PREINIT:
129         OutputStream fp;
130         GV *gv;
131     CODE:
132 #ifdef PerlIO
133         fp = PerlIO_tmpfile();
134 #else
135         fp = tmpfile();
136 #endif
137         gv = (GV*)SvREFCNT_inc(newGVgen(packname));
138         hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
139         if (do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) {
140             ST(0) = sv_2mortal(newRV((SV*)gv));
141             sv_bless(ST(0), gv_stashpv(packname, TRUE));
142             SvREFCNT_dec(gv);   /* undo increment in newRV() */
143         }
144         else {
145             ST(0) = &sv_undef;
146             SvREFCNT_dec(gv);
147         }
148
149 MODULE = IO     PACKAGE = IO::Handle    PREFIX = f
150
151 SV *
152 constant(name)
153         char *          name
154     CODE:
155         IV i;
156         if (constant(name, &i))
157             ST(0) = sv_2mortal(newSViv(i));
158         else
159             ST(0) = &sv_undef;
160
161 int
162 ungetc(handle, c)
163         InputStream     handle
164         int             c
165     CODE:
166         if (handle)
167 #ifdef PerlIO
168             RETVAL = PerlIO_ungetc(handle, c);
169 #else
170             RETVAL = ungetc(c, handle);
171 #endif
172         else {
173             RETVAL = -1;
174             errno = EINVAL;
175         }
176     OUTPUT:
177         RETVAL
178
179 int
180 ferror(handle)
181         InputStream     handle
182     CODE:
183         if (handle)
184 #ifdef PerlIO
185             RETVAL = PerlIO_error(handle);
186 #else
187             RETVAL = ferror(handle);
188 #endif
189         else {
190             RETVAL = -1;
191             errno = EINVAL;
192         }
193     OUTPUT:
194         RETVAL
195
196 int
197 clearerr(handle)
198         InputStream     handle
199     CODE:
200         if (handle) {
201 #ifdef PerlIO
202             PerlIO_clearerr(handle);
203 #else
204             clearerr(handle);
205 #endif
206             RETVAL = 0;
207         }
208         else {
209             RETVAL = -1;
210             errno = EINVAL;
211         }
212     OUTPUT:
213         RETVAL
214
215 int
216 untaint(handle)
217        SV *     handle
218     CODE:
219 #ifdef IOf_UNTAINT
220         IO * io;
221         io = sv_2io(handle);
222         if (io) {
223             IoFLAGS(io) |= IOf_UNTAINT;
224             RETVAL = 0;
225         }
226         else {
227 #endif
228             RETVAL = -1;
229             errno = EINVAL;
230 #ifdef IOf_UNTAINT
231         }
232 #endif
233     OUTPUT:
234         RETVAL
235
236 SysRet
237 fflush(handle)
238         OutputStream    handle
239     CODE:
240         if (handle)
241 #ifdef PerlIO
242             RETVAL = PerlIO_flush(handle);
243 #else
244             RETVAL = Fflush(handle);
245 #endif
246         else {
247             RETVAL = -1;
248             errno = EINVAL;
249         }
250     OUTPUT:
251         RETVAL
252
253 void
254 setbuf(handle, buf)
255         OutputStream    handle
256         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
257     CODE:
258         if (handle)
259 #ifdef PERLIO_IS_STDIO
260             setbuf(handle, buf);
261 #else
262             not_here("IO::Handle::setbuf");
263 #endif
264
265 SysRet
266 setvbuf(handle, buf, type, size)
267         OutputStream    handle
268         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
269         int             type
270         int             size
271     CODE:
272 /* Should check HAS_SETVBUF once Configure tests for that */
273 #if defined(PERLIO_IS_STDIO) && defined(_IOFBF)
274         if (handle)
275             RETVAL = setvbuf(handle, buf, type, size);
276         else {
277             RETVAL = -1;
278             errno = EINVAL;
279         }
280 #else
281         RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
282 #endif
283     OUTPUT:
284         RETVAL
285
286