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