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 |
f0f333f4 |
25 | not_here(char *s) |
8add82fc |
26 | { |
27 | croak("%s not implemented on this architecture", s); |
28 | return -1; |
29 | } |
30 | |
31 | static bool |
f0f333f4 |
32 | constant(char *name, IV *pval) |
8add82fc |
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 |
8add82fc |
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: |
8add82fc |
87 | if (handle) { |
88 | Fpos_t pos; |
2a0cf753 |
89 | #ifdef PerlIO |
760ac839 |
90 | PerlIO_getpos(handle, &pos); |
2a0cf753 |
91 | #else |
92 | fgetpos(handle, &pos); |
93 | #endif |
8add82fc |
94 | ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); |
95 | } |
96 | else { |
97 | ST(0) = &sv_undef; |
98 | errno = EINVAL; |
99 | } |
8add82fc |
100 | |
101 | SysRet |
102 | fsetpos(handle, pos) |
103 | InputStream handle |
104 | SV * pos |
105 | CODE: |
fefb1980 |
106 | char *p; |
107 | if (handle && (p = SvPVx(pos, na)) && na == sizeof(Fpos_t)) |
2a0cf753 |
108 | #ifdef PerlIO |
fefb1980 |
109 | RETVAL = PerlIO_setpos(handle, (Fpos_t*)p); |
2a0cf753 |
110 | #else |
fefb1980 |
111 | RETVAL = fsetpos(handle, (Fpos_t*)p); |
2a0cf753 |
112 | #endif |
8add82fc |
113 | else { |
114 | RETVAL = -1; |
115 | errno = EINVAL; |
116 | } |
8add82fc |
117 | OUTPUT: |
118 | RETVAL |
119 | |
120 | MODULE = IO PACKAGE = IO::File PREFIX = f |
121 | |
a375a877 |
122 | SV * |
8add82fc |
123 | new_tmpfile(packname = "IO::File") |
124 | char * packname |
a375a877 |
125 | PREINIT: |
126 | OutputStream fp; |
127 | GV *gv; |
8add82fc |
128 | CODE: |
2a0cf753 |
129 | #ifdef PerlIO |
a375a877 |
130 | fp = PerlIO_tmpfile(); |
2a0cf753 |
131 | #else |
a375a877 |
132 | fp = tmpfile(); |
2a0cf753 |
133 | #endif |
a375a877 |
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)) { |
6d5cdeed |
137 | ST(0) = sv_2mortal(newRV((SV*)gv)); |
a375a877 |
138 | sv_bless(ST(0), gv_stashpv(packname, TRUE)); |
6d5cdeed |
139 | SvREFCNT_dec(gv); /* undo increment in newRV() */ |
a375a877 |
140 | } |
141 | else { |
142 | ST(0) = &sv_undef; |
143 | SvREFCNT_dec(gv); |
144 | } |
8add82fc |
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) |
2a0cf753 |
164 | #ifdef PerlIO |
760ac839 |
165 | RETVAL = PerlIO_ungetc(handle, c); |
2a0cf753 |
166 | #else |
167 | RETVAL = ungetc(c, handle); |
168 | #endif |
8add82fc |
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) |
2a0cf753 |
181 | #ifdef PerlIO |
760ac839 |
182 | RETVAL = PerlIO_error(handle); |
2a0cf753 |
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 | } |
8add82fc |
205 | else { |
206 | RETVAL = -1; |
59629a13 |
207 | errno = EINVAL; |
208 | } |
209 | OUTPUT: |
210 | RETVAL |
211 | |
212 | int |
213 | untaint(handle) |
214 | SV * handle |
215 | CODE: |
7a4c00b4 |
216 | #ifdef IOf_UNTAINT |
59629a13 |
217 | IO * io; |
218 | io = sv_2io(handle); |
219 | if (io) { |
220 | IoFLAGS(io) |= IOf_UNTAINT; |
221 | RETVAL = 0; |
222 | } |
223 | else { |
7a4c00b4 |
224 | #endif |
59629a13 |
225 | RETVAL = -1; |
8add82fc |
226 | errno = EINVAL; |
7a4c00b4 |
227 | #ifdef IOf_UNTAINT |
8add82fc |
228 | } |
7a4c00b4 |
229 | #endif |
8add82fc |
230 | OUTPUT: |
231 | RETVAL |
232 | |
233 | SysRet |
234 | fflush(handle) |
235 | OutputStream handle |
236 | CODE: |
237 | if (handle) |
2a0cf753 |
238 | #ifdef PerlIO |
760ac839 |
239 | RETVAL = PerlIO_flush(handle); |
2a0cf753 |
240 | #else |
241 | RETVAL = Fflush(handle); |
242 | #endif |
8add82fc |
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) |
760ac839 |
256 | #ifdef PERLIO_IS_STDIO |
8add82fc |
257 | setbuf(handle, buf); |
760ac839 |
258 | #else |
259 | not_here("IO::Handle::setbuf"); |
260 | #endif |
8add82fc |
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: |
61839fa9 |
269 | /* Should check HAS_SETVBUF once Configure tests for that */ |
270 | #if defined(PERLIO_IS_STDIO) && defined(_IOFBF) |
d924de76 |
271 | if (!handle) /* Try input stream. */ |
272 | handle = IoIFP(sv_2io(ST(0))); |
8add82fc |
273 | if (handle) |
274 | RETVAL = setvbuf(handle, buf, type, size); |
275 | else { |
276 | RETVAL = -1; |
277 | errno = EINVAL; |
278 | } |
279 | #else |
61839fa9 |
280 | RETVAL = (SysRet) not_here("IO::Handle::setvbuf"); |
760ac839 |
281 | #endif |
8add82fc |
282 | OUTPUT: |
283 | RETVAL |
284 | |
285 | |