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