This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
patch for db-recno.t
[perl5.git] / ext / IO / IO.xs
CommitLineData
8add82fc 1#include "EXTERN.h"
760ac839 2#define PERLIO_NOT_STDIO 1
8add82fc
PP
3#include "perl.h"
4#include "XSUB.h"
760ac839 5
8add82fc
PP
6#ifdef I_UNISTD
7# include <unistd.h>
8#endif
760ac839
LW
9#ifdef I_FCNTL
10# include <fcntl.h>
11#endif
8add82fc 12
2a0cf753 13#ifdef PerlIO
8add82fc 14typedef int SysRet;
760ac839
LW
15typedef PerlIO * InputStream;
16typedef PerlIO * OutputStream;
2a0cf753
PP
17#else
18#define PERLIO_IS_STDIO 1
19typedef int SysRet;
20typedef FILE * InputStream;
21typedef FILE * OutputStream;
22#endif
8add82fc
PP
23
24static int
25not_here(s)
26char *s;
27{
28 croak("%s not implemented on this architecture", s);
29 return -1;
30}
31
32static bool
33constant(name, pval)
34char *name;
35IV *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
8add82fc
PP
77 break;
78 }
79
80 return FALSE;
81}
82
83
84MODULE = IO PACKAGE = IO::Seekable PREFIX = f
85
86SV *
87fgetpos(handle)
88 InputStream handle
89 CODE:
8add82fc
PP
90 if (handle) {
91 Fpos_t pos;
2a0cf753 92#ifdef PerlIO
760ac839 93 PerlIO_getpos(handle, &pos);
2a0cf753
PP
94#else
95 fgetpos(handle, &pos);
96#endif
8add82fc
PP
97 ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
98 }
99 else {
100 ST(0) = &sv_undef;
101 errno = EINVAL;
102 }
8add82fc
PP
103
104SysRet
105fsetpos(handle, pos)
106 InputStream handle
107 SV * pos
108 CODE:
8add82fc 109 if (handle)
2a0cf753 110#ifdef PerlIO
760ac839 111 RETVAL = PerlIO_setpos(handle, (Fpos_t*)SvPVX(pos));
2a0cf753
PP
112#else
113 RETVAL = fsetpos(handle, (Fpos_t*)SvPVX(pos));
114#endif
8add82fc
PP
115 else {
116 RETVAL = -1;
117 errno = EINVAL;
118 }
8add82fc
PP
119 OUTPUT:
120 RETVAL
121
122MODULE = IO PACKAGE = IO::File PREFIX = f
123
124OutputStream
125new_tmpfile(packname = "IO::File")
126 char * packname
127 CODE:
2a0cf753 128#ifdef PerlIO
760ac839 129 RETVAL = PerlIO_tmpfile();
2a0cf753
PP
130#else
131 RETVAL = tmpfile();
132#endif
8add82fc
PP
133 OUTPUT:
134 RETVAL
135
136MODULE = IO PACKAGE = IO::Handle PREFIX = f
137
138SV *
139constant(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
148int
149ungetc(handle, c)
150 InputStream handle
151 int c
152 CODE:
153 if (handle)
2a0cf753 154#ifdef PerlIO
760ac839 155 RETVAL = PerlIO_ungetc(handle, c);
2a0cf753
PP
156#else
157 RETVAL = ungetc(c, handle);
158#endif
8add82fc
PP
159 else {
160 RETVAL = -1;
161 errno = EINVAL;
162 }
163 OUTPUT:
164 RETVAL
165
166int
167ferror(handle)
168 InputStream handle
169 CODE:
170 if (handle)
2a0cf753 171#ifdef PerlIO
760ac839 172 RETVAL = PerlIO_error(handle);
2a0cf753
PP
173#else
174 RETVAL = ferror(handle);
175#endif
176 else {
177 RETVAL = -1;
178 errno = EINVAL;
179 }
180 OUTPUT:
181 RETVAL
182
183int
184clearerr(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 }
8add82fc
PP
195 else {
196 RETVAL = -1;
59629a13
RR
197 errno = EINVAL;
198 }
199 OUTPUT:
200 RETVAL
201
202int
203untaint(handle)
204 SV * handle
205 CODE:
7a4c00b4 206#ifdef IOf_UNTAINT
59629a13
RR
207 IO * io;
208 io = sv_2io(handle);
209 if (io) {
210 IoFLAGS(io) |= IOf_UNTAINT;
211 RETVAL = 0;
212 }
213 else {
7a4c00b4 214#endif
59629a13 215 RETVAL = -1;
8add82fc 216 errno = EINVAL;
7a4c00b4 217#ifdef IOf_UNTAINT
8add82fc 218 }
7a4c00b4 219#endif
8add82fc
PP
220 OUTPUT:
221 RETVAL
222
223SysRet
224fflush(handle)
225 OutputStream handle
226 CODE:
227 if (handle)
2a0cf753 228#ifdef PerlIO
760ac839 229 RETVAL = PerlIO_flush(handle);
2a0cf753
PP
230#else
231 RETVAL = Fflush(handle);
232#endif
8add82fc
PP
233 else {
234 RETVAL = -1;
235 errno = EINVAL;
236 }
237 OUTPUT:
238 RETVAL
239
240void
241setbuf(handle, buf)
242 OutputStream handle
243 char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
244 CODE:
245 if (handle)
760ac839 246#ifdef PERLIO_IS_STDIO
8add82fc 247 setbuf(handle, buf);
760ac839
LW
248#else
249 not_here("IO::Handle::setbuf");
250#endif
8add82fc
PP
251
252SysRet
253setvbuf(handle, buf, type, size)
254 OutputStream handle
255 char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
256 int type
257 int size
258 CODE:
760ac839 259#ifdef PERLIO_IS_STDIO
8add82fc
PP
260#ifdef _IOFBF /* Should be HAS_SETVBUF once Configure tests for that */
261 if (handle)
262 RETVAL = setvbuf(handle, buf, type, size);
263 else {
264 RETVAL = -1;
265 errno = EINVAL;
266 }
267#else
268 RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
269#endif /* _IOFBF */
760ac839
LW
270#else
271 not_here("IO::Handle::setvbuf");
272#endif
8add82fc
PP
273 OUTPUT:
274 RETVAL
275
276