This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.003_06: dump.c embed.h gv.c run.c
[perl5.git] / ext / IO / IO.xs
CommitLineData
8add82fc 1#include "EXTERN.h"
760ac839 2#define PERLIO_NOT_STDIO 1
8add82fc
PP
3#include "perl.h"
4#include "XSUB.h"
760ac839 5
8add82fc
PP
6#ifdef I_UNISTD
7# include <unistd.h>
8#endif
760ac839
LW
9#ifdef I_FCNTL
10# include <fcntl.h>
11#endif
8add82fc
PP
12
13typedef int SysRet;
760ac839
LW
14typedef PerlIO * InputStream;
15typedef PerlIO * OutputStream;
8add82fc
PP
16
17static int
18not_here(s)
19char *s;
20{
21 croak("%s not implemented on this architecture", s);
22 return -1;
23}
24
25static bool
26constant(name, pval)
27char *name;
28IV *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
PP
70 break;
71 }
72
73 return FALSE;
74}
75
76
77MODULE = IO PACKAGE = IO::Seekable PREFIX = f
78
79SV *
80fgetpos(handle)
81 InputStream handle
82 CODE:
8add82fc
PP
83 if (handle) {
84 Fpos_t pos;
760ac839 85 PerlIO_getpos(handle, &pos);
8add82fc
PP
86 ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
87 }
88 else {
89 ST(0) = &sv_undef;
90 errno = EINVAL;
91 }
8add82fc
PP
92
93SysRet
94fsetpos(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
PP
100 else {
101 RETVAL = -1;
102 errno = EINVAL;
103 }
8add82fc
PP
104 OUTPUT:
105 RETVAL
106
107MODULE = IO PACKAGE = IO::File PREFIX = f
108
109OutputStream
110new_tmpfile(packname = "IO::File")
111 char * packname
112 CODE:
760ac839 113 RETVAL = PerlIO_tmpfile();
8add82fc
PP
114 OUTPUT:
115 RETVAL
116
117MODULE = IO PACKAGE = IO::Handle PREFIX = f
118
119SV *
120constant(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
129int
130ungetc(handle, c)
131 InputStream handle
132 int c
133 CODE:
134 if (handle)
760ac839 135 RETVAL = PerlIO_ungetc(handle, c);
8add82fc
PP
136 else {
137 RETVAL = -1;
138 errno = EINVAL;
139 }
140 OUTPUT:
141 RETVAL
142
143int
144ferror(handle)
145 InputStream handle
146 CODE:
147 if (handle)
760ac839 148 RETVAL = PerlIO_error(handle);
8add82fc
PP
149 else {
150 RETVAL = -1;
151 errno = EINVAL;
152 }
153 OUTPUT:
154 RETVAL
155
156SysRet
157fflush(handle)
158 OutputStream handle
159 CODE:
160 if (handle)
760ac839 161 RETVAL = PerlIO_flush(handle);
8add82fc
PP
162 else {
163 RETVAL = -1;
164 errno = EINVAL;
165 }
166 OUTPUT:
167 RETVAL
168
169void
170setbuf(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
LW
177#else
178 not_here("IO::Handle::setbuf");
179#endif
8add82fc
PP
180
181SysRet
182setvbuf(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
PP
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
LW
199#else
200 not_here("IO::Handle::setvbuf");
201#endif
8add82fc
PP
202 OUTPUT:
203 RETVAL
204
205