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 | |
13 | typedef int SysRet; |
760ac839 |
14 | typedef PerlIO * InputStream; |
15 | typedef PerlIO * OutputStream; |
8add82fc |
16 | |
17 | static int |
18 | not_here(s) |
19 | char *s; |
20 | { |
21 | croak("%s not implemented on this architecture", s); |
22 | return -1; |
23 | } |
24 | |
25 | static bool |
26 | constant(name, pval) |
27 | char *name; |
28 | IV *pval; |
29 | { |
30 | switch (*name) { |
31 | case '_': |
32 | if (strEQ(name, "_IOFBF")) |
33 | #ifdef _IOFBF |
34 | { *pval = _IOFBF; return TRUE; } |
35 | #else |
36 | return FALSE; |
37 | #endif |
38 | if (strEQ(name, "_IOLBF")) |
39 | #ifdef _IOLBF |
40 | { *pval = _IOLBF; return TRUE; } |
41 | #else |
42 | return FALSE; |
43 | #endif |
44 | if (strEQ(name, "_IONBF")) |
45 | #ifdef _IONBF |
46 | { *pval = _IONBF; return TRUE; } |
47 | #else |
48 | return FALSE; |
49 | #endif |
50 | break; |
51 | case 'S': |
52 | if (strEQ(name, "SEEK_SET")) |
53 | #ifdef SEEK_SET |
54 | { *pval = SEEK_SET; return TRUE; } |
55 | #else |
56 | return FALSE; |
57 | #endif |
58 | if (strEQ(name, "SEEK_CUR")) |
59 | #ifdef SEEK_CUR |
60 | { *pval = SEEK_CUR; return TRUE; } |
61 | #else |
62 | return FALSE; |
63 | #endif |
64 | if (strEQ(name, "SEEK_END")) |
65 | #ifdef SEEK_END |
66 | { *pval = SEEK_END; return TRUE; } |
67 | #else |
68 | return FALSE; |
69 | #endif |
8add82fc |
70 | break; |
71 | } |
72 | |
73 | return FALSE; |
74 | } |
75 | |
76 | |
77 | MODULE = IO PACKAGE = IO::Seekable PREFIX = f |
78 | |
79 | SV * |
80 | fgetpos(handle) |
81 | InputStream handle |
82 | CODE: |
8add82fc |
83 | if (handle) { |
84 | Fpos_t pos; |
760ac839 |
85 | PerlIO_getpos(handle, &pos); |
8add82fc |
86 | ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); |
87 | } |
88 | else { |
89 | ST(0) = &sv_undef; |
90 | errno = EINVAL; |
91 | } |
8add82fc |
92 | |
93 | SysRet |
94 | fsetpos(handle, pos) |
95 | InputStream handle |
96 | SV * pos |
97 | CODE: |
8add82fc |
98 | if (handle) |
760ac839 |
99 | RETVAL = PerlIO_setpos(handle, (Fpos_t*)SvPVX(pos)); |
8add82fc |
100 | else { |
101 | RETVAL = -1; |
102 | errno = EINVAL; |
103 | } |
8add82fc |
104 | OUTPUT: |
105 | RETVAL |
106 | |
107 | MODULE = IO PACKAGE = IO::File PREFIX = f |
108 | |
109 | OutputStream |
110 | new_tmpfile(packname = "IO::File") |
111 | char * packname |
112 | CODE: |
760ac839 |
113 | RETVAL = PerlIO_tmpfile(); |
8add82fc |
114 | OUTPUT: |
115 | RETVAL |
116 | |
117 | MODULE = IO PACKAGE = IO::Handle PREFIX = f |
118 | |
119 | SV * |
120 | constant(name) |
121 | char * name |
122 | CODE: |
123 | IV i; |
124 | if (constant(name, &i)) |
125 | ST(0) = sv_2mortal(newSViv(i)); |
126 | else |
127 | ST(0) = &sv_undef; |
128 | |
129 | int |
130 | ungetc(handle, c) |
131 | InputStream handle |
132 | int c |
133 | CODE: |
134 | if (handle) |
760ac839 |
135 | RETVAL = PerlIO_ungetc(handle, c); |
8add82fc |
136 | else { |
137 | RETVAL = -1; |
138 | errno = EINVAL; |
139 | } |
140 | OUTPUT: |
141 | RETVAL |
142 | |
143 | int |
144 | ferror(handle) |
145 | InputStream handle |
146 | CODE: |
147 | if (handle) |
760ac839 |
148 | RETVAL = PerlIO_error(handle); |
8add82fc |
149 | else { |
150 | RETVAL = -1; |
151 | errno = EINVAL; |
152 | } |
153 | OUTPUT: |
154 | RETVAL |
155 | |
156 | SysRet |
157 | fflush(handle) |
158 | OutputStream handle |
159 | CODE: |
160 | if (handle) |
760ac839 |
161 | RETVAL = PerlIO_flush(handle); |
8add82fc |
162 | else { |
163 | RETVAL = -1; |
164 | errno = EINVAL; |
165 | } |
166 | OUTPUT: |
167 | RETVAL |
168 | |
169 | void |
170 | setbuf(handle, buf) |
171 | OutputStream handle |
172 | char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0; |
173 | CODE: |
174 | if (handle) |
760ac839 |
175 | #ifdef PERLIO_IS_STDIO |
8add82fc |
176 | setbuf(handle, buf); |
760ac839 |
177 | #else |
178 | not_here("IO::Handle::setbuf"); |
179 | #endif |
8add82fc |
180 | |
181 | SysRet |
182 | setvbuf(handle, buf, type, size) |
183 | OutputStream handle |
184 | char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; |
185 | int type |
186 | int size |
187 | CODE: |
760ac839 |
188 | #ifdef PERLIO_IS_STDIO |
8add82fc |
189 | #ifdef _IOFBF /* Should be HAS_SETVBUF once Configure tests for that */ |
190 | if (handle) |
191 | RETVAL = setvbuf(handle, buf, type, size); |
192 | else { |
193 | RETVAL = -1; |
194 | errno = EINVAL; |
195 | } |
196 | #else |
197 | RETVAL = (SysRet) not_here("IO::Handle::setvbuf"); |
198 | #endif /* _IOFBF */ |
760ac839 |
199 | #else |
200 | not_here("IO::Handle::setvbuf"); |
201 | #endif |
8add82fc |
202 | OUTPUT: |
203 | RETVAL |
204 | |
205 | |