This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix for fd leak in IO::File::new_tmpfile
[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_noinc((SV*)gv));
140             sv_bless(ST(0), gv_stashpv(packname, TRUE));
141         }
142         else {
143             ST(0) = &sv_undef;
144             SvREFCNT_dec(gv);
145         }
146
147 MODULE = IO     PACKAGE = IO::Handle    PREFIX = f
148
149 SV *
150 constant(name)
151         char *          name
152     CODE:
153         IV i;
154         if (constant(name, &i))
155             ST(0) = sv_2mortal(newSViv(i));
156         else
157             ST(0) = &sv_undef;
158
159 int
160 ungetc(handle, c)
161         InputStream     handle
162         int             c
163     CODE:
164         if (handle)
165 #ifdef PerlIO
166             RETVAL = PerlIO_ungetc(handle, c);
167 #else
168             RETVAL = ungetc(c, handle);
169 #endif
170         else {
171             RETVAL = -1;
172             errno = EINVAL;
173         }
174     OUTPUT:
175         RETVAL
176
177 int
178 ferror(handle)
179         InputStream     handle
180     CODE:
181         if (handle)
182 #ifdef PerlIO
183             RETVAL = PerlIO_error(handle);
184 #else
185             RETVAL = ferror(handle);
186 #endif
187         else {
188             RETVAL = -1;
189             errno = EINVAL;
190         }
191     OUTPUT:
192         RETVAL
193
194 int
195 clearerr(handle)
196         InputStream     handle
197     CODE:
198         if (handle) {
199 #ifdef PerlIO
200             PerlIO_clearerr(handle);
201 #else
202             clearerr(handle);
203 #endif
204             RETVAL = 0;
205         }
206         else {
207             RETVAL = -1;
208             errno = EINVAL;
209         }
210     OUTPUT:
211         RETVAL
212
213 int
214 untaint(handle)
215        SV *     handle
216     CODE:
217 #ifdef IOf_UNTAINT
218         IO * io;
219         io = sv_2io(handle);
220         if (io) {
221             IoFLAGS(io) |= IOf_UNTAINT;
222             RETVAL = 0;
223         }
224         else {
225 #endif
226             RETVAL = -1;
227             errno = EINVAL;
228 #ifdef IOf_UNTAINT
229         }
230 #endif
231     OUTPUT:
232         RETVAL
233
234 SysRet
235 fflush(handle)
236         OutputStream    handle
237     CODE:
238         if (handle)
239 #ifdef PerlIO
240             RETVAL = PerlIO_flush(handle);
241 #else
242             RETVAL = Fflush(handle);
243 #endif
244         else {
245             RETVAL = -1;
246             errno = EINVAL;
247         }
248     OUTPUT:
249         RETVAL
250
251 void
252 setbuf(handle, buf)
253         OutputStream    handle
254         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
255     CODE:
256         if (handle)
257 #ifdef PERLIO_IS_STDIO
258             setbuf(handle, buf);
259 #else
260             not_here("IO::Handle::setbuf");
261 #endif
262
263 SysRet
264 setvbuf(handle, buf, type, size)
265         OutputStream    handle
266         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
267         int             type
268         int             size
269     CODE:
270 #ifdef PERLIO_IS_STDIO
271 #ifdef _IOFBF   /* Should be HAS_SETVBUF once Configure tests for that */
272         if (handle)
273             RETVAL = setvbuf(handle, buf, type, size);
274         else {
275             RETVAL = -1;
276             errno = EINVAL;
277         }
278 #else
279             RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
280 #endif /* _IOFBF */
281 #else
282             not_here("IO::Handle::setvbuf");
283 #endif
284     OUTPUT:
285         RETVAL
286
287