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