This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Updated to IO-1.12.
[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 OutputStream
125 new_tmpfile(packname = "IO::File")
126     char *              packname
127     CODE:
128 #ifdef PerlIO
129         RETVAL = PerlIO_tmpfile();
130 #else
131         RETVAL = tmpfile();
132 #endif
133     OUTPUT:
134         RETVAL
135
136 MODULE = IO     PACKAGE = IO::Handle    PREFIX = f
137
138 SV *
139 constant(name)
140         char *          name
141     CODE:
142         IV i;
143         if (constant(name, &i))
144             ST(0) = sv_2mortal(newSViv(i));
145         else
146             ST(0) = &sv_undef;
147
148 int
149 ungetc(handle, c)
150         InputStream     handle
151         int             c
152     CODE:
153         if (handle)
154 #ifdef PerlIO
155             RETVAL = PerlIO_ungetc(handle, c);
156 #else
157             RETVAL = ungetc(c, handle);
158 #endif
159         else {
160             RETVAL = -1;
161             errno = EINVAL;
162         }
163     OUTPUT:
164         RETVAL
165
166 int
167 ferror(handle)
168         InputStream     handle
169     CODE:
170         if (handle)
171 #ifdef PerlIO
172             RETVAL = PerlIO_error(handle);
173 #else
174             RETVAL = ferror(handle);
175 #endif
176         else {
177             RETVAL = -1;
178             errno = EINVAL;
179         }
180     OUTPUT:
181         RETVAL
182
183 int
184 clearerr(handle)
185         InputStream     handle
186     CODE:
187         if (handle) {
188 #ifdef PerlIO
189             PerlIO_clearerr(handle);
190 #else
191             clearerr(handle);
192 #endif
193             RETVAL = 0;
194         }
195         else {
196             RETVAL = -1;
197             errno = EINVAL;
198         }
199     OUTPUT:
200         RETVAL
201
202 SysRet
203 fflush(handle)
204         OutputStream    handle
205     CODE:
206         if (handle)
207 #ifdef PerlIO
208             RETVAL = PerlIO_flush(handle);
209 #else
210             RETVAL = Fflush(handle);
211 #endif
212         else {
213             RETVAL = -1;
214             errno = EINVAL;
215         }
216     OUTPUT:
217         RETVAL
218
219 void
220 setbuf(handle, buf)
221         OutputStream    handle
222         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
223     CODE:
224         if (handle)
225 #ifdef PERLIO_IS_STDIO
226             setbuf(handle, buf);
227 #else
228             not_here("IO::Handle::setbuf");
229 #endif
230
231 SysRet
232 setvbuf(handle, buf, type, size)
233         OutputStream    handle
234         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
235         int             type
236         int             size
237     CODE:
238 #ifdef PERLIO_IS_STDIO
239 #ifdef _IOFBF   /* Should be HAS_SETVBUF once Configure tests for that */
240         if (handle)
241             RETVAL = setvbuf(handle, buf, type, size);
242         else {
243             RETVAL = -1;
244             errno = EINVAL;
245         }
246 #else
247             RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
248 #endif /* _IOFBF */
249 #else
250             not_here("IO::Handle::setvbuf");
251 #endif
252     OUTPUT:
253         RETVAL
254
255