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