This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Refresh Text::Wrap to 97.011701
[perl5.git] / ext / Fcntl / Fcntl.xs
CommitLineData
a0d0e21e
LW
1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
75ced34b
PP
5#ifdef VMS
6# include <file.h>
7#else
8# include <fcntl.h>
9#endif
a0d0e21e 10
8e07c86e
AD
11/* This comment is a kludge to get metaconfig to see the symbols
12 VAL_O_NONBLOCK
13 VAL_EAGAIN
14 RD_NODATA
15 EOF_NONBLOCK
16 and include the appropriate metaconfig unit
17 so that Configure will test how to turn on non-blocking I/O
18 for a file descriptor. See config.h for how to use these
19 in your extension.
20
21 While I'm at it, I'll have metaconfig look for HAS_POLL too.
22 --AD October 16, 1995
23*/
24
a0d0e21e
LW
25static int
26not_here(s)
27char *s;
28{
29 croak("%s not implemented on this architecture", s);
30 return -1;
31}
32
33static double
34constant(name, arg)
35char *name;
36int arg;
37{
38 errno = 0;
39 switch (*name) {
40 case 'F':
41 if (strnEQ(name, "F_", 2)) {
42 if (strEQ(name, "F_DUPFD"))
43#ifdef F_DUPFD
44 return F_DUPFD;
45#else
46 goto not_there;
47#endif
48 if (strEQ(name, "F_GETFD"))
49#ifdef F_GETFD
50 return F_GETFD;
51#else
52 goto not_there;
53#endif
54 if (strEQ(name, "F_GETLK"))
55#ifdef F_GETLK
56 return F_GETLK;
57#else
58 goto not_there;
59#endif
60 if (strEQ(name, "F_SETFD"))
61#ifdef F_SETFD
62 return F_SETFD;
63#else
64 goto not_there;
65#endif
66 if (strEQ(name, "F_GETFL"))
67#ifdef F_GETFL
68 return F_GETFL;
69#else
70 goto not_there;
71#endif
232e078e
AD
72 if (strEQ(name, "F_SETFL"))
73#ifdef F_SETFL
74 return F_SETFL;
a0d0e21e
LW
75#else
76 goto not_there;
77#endif
78 if (strEQ(name, "F_SETLK"))
79#ifdef F_SETLK
80 return F_SETLK;
81#else
82 goto not_there;
83#endif
84 if (strEQ(name, "F_SETLKW"))
85#ifdef F_SETLKW
86 return F_SETLKW;
87#else
88 goto not_there;
89#endif
90 if (strEQ(name, "F_RDLCK"))
91#ifdef F_RDLCK
92 return F_RDLCK;
93#else
94 goto not_there;
95#endif
96 if (strEQ(name, "F_UNLCK"))
97#ifdef F_UNLCK
98 return F_UNLCK;
99#else
100 goto not_there;
101#endif
102 if (strEQ(name, "F_WRLCK"))
103#ifdef F_WRLCK
104 return F_WRLCK;
105#else
106 goto not_there;
107#endif
108 errno = EINVAL;
109 return 0;
110 } else
111 if (strEQ(name, "FD_CLOEXEC"))
112#ifdef FD_CLOEXEC
113 return FD_CLOEXEC;
114#else
115 goto not_there;
116#endif
117 break;
7e1af8bc
PP
118 case 'L':
119 if (strnEQ(name, "LOCK_", 5)) {
120 /* We support flock() on systems which don't have it, so
121 always supply the constants. */
122 if (strEQ(name, "LOCK_SH"))
123#ifdef LOCK_SH
124 return LOCK_SH;
125#else
126 return 1;
127#endif
128 if (strEQ(name, "LOCK_EX"))
129#ifdef LOCK_EX
130 return LOCK_EX;
131#else
132 return 2;
133#endif
134 if (strEQ(name, "LOCK_NB"))
135#ifdef LOCK_NB
136 return LOCK_NB;
137#else
138 return 4;
139#endif
140 if (strEQ(name, "LOCK_UN"))
141#ifdef LOCK_UN
142 return LOCK_UN;
143#else
144 return 8;
145#endif
146 } else
147 goto not_there;
148 break;
a0d0e21e
LW
149 case 'O':
150 if (strnEQ(name, "O_", 2)) {
151 if (strEQ(name, "O_CREAT"))
152#ifdef O_CREAT
153 return O_CREAT;
154#else
155 goto not_there;
156#endif
157 if (strEQ(name, "O_EXCL"))
158#ifdef O_EXCL
159 return O_EXCL;
160#else
161 goto not_there;
162#endif
163 if (strEQ(name, "O_NOCTTY"))
164#ifdef O_NOCTTY
165 return O_NOCTTY;
166#else
167 goto not_there;
168#endif
169 if (strEQ(name, "O_TRUNC"))
170#ifdef O_TRUNC
171 return O_TRUNC;
172#else
173 goto not_there;
174#endif
175 if (strEQ(name, "O_APPEND"))
176#ifdef O_APPEND
177 return O_APPEND;
178#else
179 goto not_there;
180#endif
181 if (strEQ(name, "O_NONBLOCK"))
182#ifdef O_NONBLOCK
183 return O_NONBLOCK;
184#else
185 goto not_there;
186#endif
187 if (strEQ(name, "O_NDELAY"))
188#ifdef O_NDELAY
189 return O_NDELAY;
190#else
191 goto not_there;
192#endif
193 if (strEQ(name, "O_RDONLY"))
194#ifdef O_RDONLY
195 return O_RDONLY;
196#else
197 goto not_there;
198#endif
199 if (strEQ(name, "O_RDWR"))
200#ifdef O_RDWR
201 return O_RDWR;
202#else
203 goto not_there;
204#endif
205 if (strEQ(name, "O_WRONLY"))
206#ifdef O_WRONLY
207 return O_WRONLY;
208#else
209 goto not_there;
210#endif
4633a7c4
LW
211 if (strEQ(name, "O_BINARY"))
212#ifdef O_BINARY
213 return O_BINARY;
214#else
215 goto not_there;
216#endif
705af498
JH
217 if (strEQ(name, "O_EXLOCK"))
218#ifdef O_EXLOCK
219 return O_EXLOCK;
220#else
221 goto not_there;
222#endif
223 if (strEQ(name, "O_SHLOCK"))
224#ifdef O_SHLOCK
225 return O_SHLOCK;
226#else
227 goto not_there;
228#endif
229 if (strEQ(name, "O_ASYNC"))
230#ifdef O_ASYNC
231 return O_ASYNC;
232#else
233 goto not_there;
234#endif
235 if (strEQ(name, "O_DSYNC"))
236#ifdef O_DSYNC
237 return O_DSYNC;
238#else
239 goto not_there;
240#endif
241 if (strEQ(name, "O_RSYNC"))
242#ifdef O_RSYNC
243 return O_RSYNC;
244#else
245 goto not_there;
246#endif
247 if (strEQ(name, "O_SYNC"))
248#ifdef O_SYNC
249 return O_SYNC;
250#else
251 goto not_there;
252#endif
253 if (strEQ(name, "F_SETOWN"))
254#ifdef F_SETOWN
255 return F_SETOWN;
256#else
257 goto not_there;
258#endif
259 if (strEQ(name, "F_GETOWN"))
260#ifdef F_GETOWN
261 return F_GETOWN;
262#else
263 goto not_there;
264#endif
265 if (strEQ(name, "O_DEFER"))
266#ifdef O_DEFER
267 return O_DEFER;
268#else
269 goto not_there;
270#endif
a0d0e21e
LW
271 } else
272 goto not_there;
273 break;
274 }
275 errno = EINVAL;
276 return 0;
277
278not_there:
279 errno = ENOENT;
280 return 0;
281}
282
283
284MODULE = Fcntl PACKAGE = Fcntl
285
286double
287constant(name,arg)
288 char * name
289 int arg
290