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