Commit | Line | Data |
8add82fc |
1 | #include "EXTERN.h" |
760ac839 |
2 | #define PERLIO_NOT_STDIO 1 |
8add82fc |
3 | #include "perl.h" |
4 | #include "XSUB.h" |
760ac839 |
5 | |
8add82fc |
6 | #ifdef I_UNISTD |
7 | # include <unistd.h> |
8 | #endif |
760ac839 |
9 | #ifdef I_FCNTL |
10 | # include <fcntl.h> |
11 | #endif |
8add82fc |
12 | |
2a0cf753 |
13 | #ifdef PerlIO |
8add82fc |
14 | typedef int SysRet; |
760ac839 |
15 | typedef PerlIO * InputStream; |
16 | typedef PerlIO * OutputStream; |
2a0cf753 |
17 | #else |
18 | #define PERLIO_IS_STDIO 1 |
19 | typedef int SysRet; |
20 | typedef FILE * InputStream; |
21 | typedef FILE * OutputStream; |
22 | #endif |
8add82fc |
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 |
8add82fc |
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: |
8add82fc |
90 | if (handle) { |
91 | Fpos_t pos; |
2a0cf753 |
92 | #ifdef PerlIO |
760ac839 |
93 | PerlIO_getpos(handle, &pos); |
2a0cf753 |
94 | #else |
95 | fgetpos(handle, &pos); |
96 | #endif |
8add82fc |
97 | ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); |
98 | } |
99 | else { |
100 | ST(0) = &sv_undef; |
101 | errno = EINVAL; |
102 | } |
8add82fc |
103 | |
104 | SysRet |
105 | fsetpos(handle, pos) |
106 | InputStream handle |
107 | SV * pos |
108 | CODE: |
fefb1980 |
109 | char *p; |
110 | if (handle && (p = SvPVx(pos, na)) && na == sizeof(Fpos_t)) |
2a0cf753 |
111 | #ifdef PerlIO |
fefb1980 |
112 | RETVAL = PerlIO_setpos(handle, (Fpos_t*)p); |
2a0cf753 |
113 | #else |
fefb1980 |
114 | RETVAL = fsetpos(handle, (Fpos_t*)p); |
2a0cf753 |
115 | #endif |
8add82fc |
116 | else { |
117 | RETVAL = -1; |
118 | errno = EINVAL; |
119 | } |
8add82fc |
120 | OUTPUT: |
121 | RETVAL |
122 | |
123 | MODULE = IO PACKAGE = IO::File PREFIX = f |
124 | |
a375a877 |
125 | SV * |
8add82fc |
126 | new_tmpfile(packname = "IO::File") |
127 | char * packname |
a375a877 |
128 | PREINIT: |
129 | OutputStream fp; |
130 | GV *gv; |
8add82fc |
131 | CODE: |
2a0cf753 |
132 | #ifdef PerlIO |
a375a877 |
133 | fp = PerlIO_tmpfile(); |
2a0cf753 |
134 | #else |
a375a877 |
135 | fp = tmpfile(); |
2a0cf753 |
136 | #endif |
a375a877 |
137 | gv = (GV*)SvREFCNT_inc(newGVgen(packname)); |
138 | hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD); |
139 | if (do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) { |
6d5cdeed |
140 | ST(0) = sv_2mortal(newRV((SV*)gv)); |
a375a877 |
141 | sv_bless(ST(0), gv_stashpv(packname, TRUE)); |
6d5cdeed |
142 | SvREFCNT_dec(gv); /* undo increment in newRV() */ |
a375a877 |
143 | } |
144 | else { |
145 | ST(0) = &sv_undef; |
146 | SvREFCNT_dec(gv); |
147 | } |
8add82fc |
148 | |
149 | MODULE = IO PACKAGE = IO::Handle PREFIX = f |
150 | |
151 | SV * |
152 | constant(name) |
153 | char * name |
154 | CODE: |
155 | IV i; |
156 | if (constant(name, &i)) |
157 | ST(0) = sv_2mortal(newSViv(i)); |
158 | else |
159 | ST(0) = &sv_undef; |
160 | |
161 | int |
162 | ungetc(handle, c) |
163 | InputStream handle |
164 | int c |
165 | CODE: |
166 | if (handle) |
2a0cf753 |
167 | #ifdef PerlIO |
760ac839 |
168 | RETVAL = PerlIO_ungetc(handle, c); |
2a0cf753 |
169 | #else |
170 | RETVAL = ungetc(c, handle); |
171 | #endif |
8add82fc |
172 | else { |
173 | RETVAL = -1; |
174 | errno = EINVAL; |
175 | } |
176 | OUTPUT: |
177 | RETVAL |
178 | |
179 | int |
180 | ferror(handle) |
181 | InputStream handle |
182 | CODE: |
183 | if (handle) |
2a0cf753 |
184 | #ifdef PerlIO |
760ac839 |
185 | RETVAL = PerlIO_error(handle); |
2a0cf753 |
186 | #else |
187 | RETVAL = ferror(handle); |
188 | #endif |
189 | else { |
190 | RETVAL = -1; |
191 | errno = EINVAL; |
192 | } |
193 | OUTPUT: |
194 | RETVAL |
195 | |
196 | int |
197 | clearerr(handle) |
198 | InputStream handle |
199 | CODE: |
200 | if (handle) { |
201 | #ifdef PerlIO |
202 | PerlIO_clearerr(handle); |
203 | #else |
204 | clearerr(handle); |
205 | #endif |
206 | RETVAL = 0; |
207 | } |
8add82fc |
208 | else { |
209 | RETVAL = -1; |
59629a13 |
210 | errno = EINVAL; |
211 | } |
212 | OUTPUT: |
213 | RETVAL |
214 | |
215 | int |
216 | untaint(handle) |
217 | SV * handle |
218 | CODE: |
7a4c00b4 |
219 | #ifdef IOf_UNTAINT |
59629a13 |
220 | IO * io; |
221 | io = sv_2io(handle); |
222 | if (io) { |
223 | IoFLAGS(io) |= IOf_UNTAINT; |
224 | RETVAL = 0; |
225 | } |
226 | else { |
7a4c00b4 |
227 | #endif |
59629a13 |
228 | RETVAL = -1; |
8add82fc |
229 | errno = EINVAL; |
7a4c00b4 |
230 | #ifdef IOf_UNTAINT |
8add82fc |
231 | } |
7a4c00b4 |
232 | #endif |
8add82fc |
233 | OUTPUT: |
234 | RETVAL |
235 | |
236 | SysRet |
237 | fflush(handle) |
238 | OutputStream handle |
239 | CODE: |
240 | if (handle) |
2a0cf753 |
241 | #ifdef PerlIO |
760ac839 |
242 | RETVAL = PerlIO_flush(handle); |
2a0cf753 |
243 | #else |
244 | RETVAL = Fflush(handle); |
245 | #endif |
8add82fc |
246 | else { |
247 | RETVAL = -1; |
248 | errno = EINVAL; |
249 | } |
250 | OUTPUT: |
251 | RETVAL |
252 | |
253 | void |
254 | setbuf(handle, buf) |
255 | OutputStream handle |
256 | char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0; |
257 | CODE: |
258 | if (handle) |
760ac839 |
259 | #ifdef PERLIO_IS_STDIO |
8add82fc |
260 | setbuf(handle, buf); |
760ac839 |
261 | #else |
262 | not_here("IO::Handle::setbuf"); |
263 | #endif |
8add82fc |
264 | |
265 | SysRet |
266 | setvbuf(handle, buf, type, size) |
267 | OutputStream handle |
268 | char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; |
269 | int type |
270 | int size |
271 | CODE: |
61839fa9 |
272 | /* Should check HAS_SETVBUF once Configure tests for that */ |
273 | #if defined(PERLIO_IS_STDIO) && defined(_IOFBF) |
8add82fc |
274 | if (handle) |
275 | RETVAL = setvbuf(handle, buf, type, size); |
276 | else { |
277 | RETVAL = -1; |
278 | errno = EINVAL; |
279 | } |
280 | #else |
61839fa9 |
281 | RETVAL = (SysRet) not_here("IO::Handle::setvbuf"); |
760ac839 |
282 | #endif |
8add82fc |
283 | OUTPUT: |
284 | RETVAL |
285 | |
286 | |