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 | |
124 | OutputStream |
125 | new_tmpfile(packname = "IO::File") |
126 | char * packname |
127 | CODE: |
2a0cf753 |
128 | #ifdef PerlIO |
760ac839 |
129 | RETVAL = PerlIO_tmpfile(); |
2a0cf753 |
130 | #else |
131 | RETVAL = tmpfile(); |
132 | #endif |
8add82fc |
133 | OUTPUT: |
134 | RETVAL |
135 | |
136 | MODULE = IO PACKAGE = IO::Handle PREFIX = f |
137 | |
138 | SV * |
139 | constant(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 | |
148 | int |
149 | ungetc(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 |
156 | #else |
157 | RETVAL = ungetc(c, handle); |
158 | #endif |
8add82fc |
159 | else { |
160 | RETVAL = -1; |
161 | errno = EINVAL; |
162 | } |
163 | OUTPUT: |
164 | RETVAL |
165 | |
166 | int |
167 | ferror(handle) |
168 | InputStream handle |
169 | CODE: |
170 | if (handle) |
2a0cf753 |
171 | #ifdef PerlIO |
760ac839 |
172 | RETVAL = PerlIO_error(handle); |
2a0cf753 |
173 | #else |
174 | RETVAL = ferror(handle); |
175 | #endif |
176 | else { |
177 | RETVAL = -1; |
178 | errno = EINVAL; |
179 | } |
180 | OUTPUT: |
181 | RETVAL |
182 | |
183 | int |
184 | clearerr(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 |
195 | else { |
196 | RETVAL = -1; |
59629a13 |
197 | errno = EINVAL; |
198 | } |
199 | OUTPUT: |
200 | RETVAL |
201 | |
202 | int |
203 | untaint(handle) |
204 | SV * handle |
205 | CODE: |
206 | IO * io; |
207 | io = sv_2io(handle); |
208 | if (io) { |
209 | IoFLAGS(io) |= IOf_UNTAINT; |
210 | RETVAL = 0; |
211 | } |
212 | else { |
213 | RETVAL = -1; |
8add82fc |
214 | errno = EINVAL; |
215 | } |
216 | OUTPUT: |
217 | RETVAL |
218 | |
219 | SysRet |
220 | fflush(handle) |
221 | OutputStream handle |
222 | CODE: |
223 | if (handle) |
2a0cf753 |
224 | #ifdef PerlIO |
760ac839 |
225 | RETVAL = PerlIO_flush(handle); |
2a0cf753 |
226 | #else |
227 | RETVAL = Fflush(handle); |
228 | #endif |
8add82fc |
229 | else { |
230 | RETVAL = -1; |
231 | errno = EINVAL; |
232 | } |
233 | OUTPUT: |
234 | RETVAL |
235 | |
236 | void |
237 | setbuf(handle, buf) |
238 | OutputStream handle |
239 | char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0; |
240 | CODE: |
241 | if (handle) |
760ac839 |
242 | #ifdef PERLIO_IS_STDIO |
8add82fc |
243 | setbuf(handle, buf); |
760ac839 |
244 | #else |
245 | not_here("IO::Handle::setbuf"); |
246 | #endif |
8add82fc |
247 | |
248 | SysRet |
249 | setvbuf(handle, buf, type, size) |
250 | OutputStream handle |
251 | char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; |
252 | int type |
253 | int size |
254 | CODE: |
760ac839 |
255 | #ifdef PERLIO_IS_STDIO |
8add82fc |
256 | #ifdef _IOFBF /* Should be HAS_SETVBUF once Configure tests for that */ |
257 | if (handle) |
258 | RETVAL = setvbuf(handle, buf, type, size); |
259 | else { |
260 | RETVAL = -1; |
261 | errno = EINVAL; |
262 | } |
263 | #else |
264 | RETVAL = (SysRet) not_here("IO::Handle::setvbuf"); |
265 | #endif /* _IOFBF */ |
760ac839 |
266 | #else |
267 | not_here("IO::Handle::setvbuf"); |
268 | #endif |
8add82fc |
269 | OUTPUT: |
270 | RETVAL |
271 | |
272 | |