This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fcntl.xs: F_[GS]ETOWN were in wrong case branch
[perl5.git] / ext / Fcntl / Fcntl.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #ifdef VMS
6 #  include <file.h>
7 #else
8 #  include <fcntl.h>
9 #endif
10
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
25 static int
26 not_here(s)
27 char *s;
28 {
29     croak("%s not implemented on this architecture", s);
30     return -1;
31 }
32
33 static double
34 constant(name, arg)
35 char *name;
36 int 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_GETOWN"))
61 #ifdef F_GETOWN
62                 return F_GETOWN;
63 #else
64                 goto not_there;
65 #endif
66             if (strEQ(name, "F_SETFD"))
67 #ifdef F_SETFD
68                 return F_SETFD;
69 #else
70                 goto not_there;
71 #endif
72             if (strEQ(name, "F_GETFL"))
73 #ifdef F_GETFL
74                 return F_GETFL;
75 #else
76                 goto not_there;
77 #endif
78             if (strEQ(name, "F_SETFL"))
79 #ifdef F_SETFL
80                 return F_SETFL;
81 #else
82                 goto not_there;
83 #endif
84             if (strEQ(name, "F_SETLK"))
85 #ifdef F_SETLK
86                 return F_SETLK;
87 #else
88                 goto not_there;
89 #endif
90             if (strEQ(name, "F_SETLKW"))
91 #ifdef F_SETLKW
92                 return F_SETLKW;
93 #else
94                 goto not_there;
95 #endif
96             if (strEQ(name, "F_SETOWN"))
97 #ifdef F_SETOWN
98                 return F_SETOWN;
99 #else
100                 goto not_there;
101 #endif
102             if (strEQ(name, "F_RDLCK"))
103 #ifdef F_RDLCK
104                 return F_RDLCK;
105 #else
106                 goto not_there;
107 #endif
108             if (strEQ(name, "F_UNLCK"))
109 #ifdef F_UNLCK
110                 return F_UNLCK;
111 #else
112                 goto not_there;
113 #endif
114             if (strEQ(name, "F_WRLCK"))
115 #ifdef F_WRLCK
116                 return F_WRLCK;
117 #else
118                 goto not_there;
119 #endif
120             errno = EINVAL;
121             return 0;
122         } else
123           if (strEQ(name, "FD_CLOEXEC"))
124 #ifdef FD_CLOEXEC
125             return FD_CLOEXEC;
126 #else
127             goto not_there;
128 #endif
129         break;
130     case 'L':
131         if (strnEQ(name, "LOCK_", 5)) {
132             /* We support flock() on systems which don't have it, so
133                always supply the constants. */
134             if (strEQ(name, "LOCK_SH"))
135 #ifdef LOCK_SH
136                 return LOCK_SH;
137 #else
138                 return 1;
139 #endif
140             if (strEQ(name, "LOCK_EX"))
141 #ifdef LOCK_EX
142                 return LOCK_EX;
143 #else
144                 return 2;
145 #endif
146             if (strEQ(name, "LOCK_NB"))
147 #ifdef LOCK_NB
148                 return LOCK_NB;
149 #else
150                 return 4;
151 #endif
152             if (strEQ(name, "LOCK_UN"))
153 #ifdef LOCK_UN
154                 return LOCK_UN;
155 #else
156                 return 8;
157 #endif
158         } else
159           goto not_there;
160         break;
161     case 'O':
162         if (strnEQ(name, "O_", 2)) {
163             if (strEQ(name, "O_CREAT"))
164 #ifdef O_CREAT
165                 return O_CREAT;
166 #else
167                 goto not_there;
168 #endif
169             if (strEQ(name, "O_EXCL"))
170 #ifdef O_EXCL
171                 return O_EXCL;
172 #else
173                 goto not_there;
174 #endif
175             if (strEQ(name, "O_NOCTTY"))
176 #ifdef O_NOCTTY
177                 return O_NOCTTY;
178 #else
179                 goto not_there;
180 #endif
181             if (strEQ(name, "O_TRUNC"))
182 #ifdef O_TRUNC
183                 return O_TRUNC;
184 #else
185                 goto not_there;
186 #endif
187             if (strEQ(name, "O_APPEND"))
188 #ifdef O_APPEND
189                 return O_APPEND;
190 #else
191                 goto not_there;
192 #endif
193             if (strEQ(name, "O_NONBLOCK"))
194 #ifdef O_NONBLOCK
195                 return O_NONBLOCK;
196 #else
197                 goto not_there;
198 #endif
199             if (strEQ(name, "O_NDELAY"))
200 #ifdef O_NDELAY
201                 return O_NDELAY;
202 #else
203                 goto not_there;
204 #endif
205             if (strEQ(name, "O_RDONLY"))
206 #ifdef O_RDONLY
207                 return O_RDONLY;
208 #else
209                 goto not_there;
210 #endif
211             if (strEQ(name, "O_RDWR"))
212 #ifdef O_RDWR
213                 return O_RDWR;
214 #else
215                 goto not_there;
216 #endif
217             if (strEQ(name, "O_WRONLY"))
218 #ifdef O_WRONLY
219                 return O_WRONLY;
220 #else
221                 goto not_there;
222 #endif
223             if (strEQ(name, "O_BINARY"))
224 #ifdef O_BINARY
225                 return O_BINARY;
226 #else
227                 goto not_there;
228 #endif
229             if (strEQ(name, "O_EXLOCK"))
230 #ifdef O_EXLOCK
231                 return O_EXLOCK;
232 #else
233                 goto not_there;
234 #endif
235             if (strEQ(name, "O_SHLOCK"))
236 #ifdef O_SHLOCK
237                 return O_SHLOCK;
238 #else
239                 goto not_there;
240 #endif
241             if (strEQ(name, "O_ASYNC"))
242 #ifdef O_ASYNC
243                 return O_ASYNC;
244 #else
245                 goto not_there;
246 #endif
247             if (strEQ(name, "O_DSYNC"))
248 #ifdef O_DSYNC
249                 return O_DSYNC;
250 #else
251                 goto not_there;
252 #endif
253             if (strEQ(name, "O_RSYNC"))
254 #ifdef O_RSYNC
255                 return O_RSYNC;
256 #else
257                 goto not_there;
258 #endif
259             if (strEQ(name, "O_SYNC"))
260 #ifdef O_SYNC
261                 return O_SYNC;
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
271         } else
272           goto not_there;
273         break;
274     }
275     errno = EINVAL;
276     return 0;
277
278 not_there:
279     errno = ENOENT;
280     return 0;
281 }
282
283
284 MODULE = Fcntl          PACKAGE = Fcntl
285
286 double
287 constant(name,arg)
288         char *          name
289         int             arg
290