This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update SH_PATH comment.
[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;
197 errno = EINVAL;
198 }
199 OUTPUT:
200 RETVAL
201
202SysRet
203fflush(handle)
204 OutputStream handle
205 CODE:
206 if (handle)
2a0cf753 207#ifdef PerlIO
760ac839 208 RETVAL = PerlIO_flush(handle);
2a0cf753
PP
209#else
210 RETVAL = Fflush(handle);
211#endif
8add82fc
PP
212 else {
213 RETVAL = -1;
214 errno = EINVAL;
215 }
216 OUTPUT:
217 RETVAL
218
219void
220setbuf(handle, buf)
221 OutputStream handle
222 char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
223 CODE:
224 if (handle)
760ac839 225#ifdef PERLIO_IS_STDIO
8add82fc 226 setbuf(handle, buf);
760ac839
LW
227#else
228 not_here("IO::Handle::setbuf");
229#endif
8add82fc
PP
230
231SysRet
232setvbuf(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:
760ac839 238#ifdef PERLIO_IS_STDIO
8add82fc
PP
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 */
760ac839
LW
249#else
250 not_here("IO::Handle::setvbuf");
251#endif
8add82fc
PP
252 OUTPUT:
253 RETVAL
254
255