This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5.001 patch.1c
[perl5.git] / ext / Fcntl / Fcntl.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include <fcntl.h>
6
7 static int
8 not_here(s)
9 char *s;
10 {
11     croak("%s not implemented on this architecture", s);
12     return -1;
13 }
14
15 static double
16 constant(name, arg)
17 char *name;
18 int arg;
19 {
20     errno = 0;
21     switch (*name) {
22     case 'F':
23         if (strnEQ(name, "F_", 2)) {
24             if (strEQ(name, "F_DUPFD"))
25 #ifdef F_DUPFD
26                 return F_DUPFD;
27 #else
28                 goto not_there;
29 #endif
30             if (strEQ(name, "F_GETFD"))
31 #ifdef F_GETFD
32                 return F_GETFD;
33 #else
34                 goto not_there;
35 #endif
36             if (strEQ(name, "F_GETLK"))
37 #ifdef F_GETLK
38                 return F_GETLK;
39 #else
40                 goto not_there;
41 #endif
42             if (strEQ(name, "F_SETFD"))
43 #ifdef F_SETFD
44                 return F_SETFD;
45 #else
46                 goto not_there;
47 #endif
48             if (strEQ(name, "F_GETFL"))
49 #ifdef F_GETFL
50                 return F_GETFL;
51 #else
52                 goto not_there;
53 #endif
54             if (strEQ(name, "F_SETFL"))
55 #ifdef F_SETFL
56                 return F_SETFL;
57 #else
58                 goto not_there;
59 #endif
60             if (strEQ(name, "F_SETLK"))
61 #ifdef F_SETLK
62                 return F_SETLK;
63 #else
64                 goto not_there;
65 #endif
66             if (strEQ(name, "F_SETLKW"))
67 #ifdef F_SETLKW
68                 return F_SETLKW;
69 #else
70                 goto not_there;
71 #endif
72             if (strEQ(name, "F_RDLCK"))
73 #ifdef F_RDLCK
74                 return F_RDLCK;
75 #else
76                 goto not_there;
77 #endif
78             if (strEQ(name, "F_UNLCK"))
79 #ifdef F_UNLCK
80                 return F_UNLCK;
81 #else
82                 goto not_there;
83 #endif
84             if (strEQ(name, "F_WRLCK"))
85 #ifdef F_WRLCK
86                 return F_WRLCK;
87 #else
88                 goto not_there;
89 #endif
90             errno = EINVAL;
91             return 0;
92         } else
93           if (strEQ(name, "FD_CLOEXEC"))
94 #ifdef FD_CLOEXEC
95             return FD_CLOEXEC;
96 #else
97             goto not_there;
98 #endif
99         break;
100     case 'O':
101         if (strnEQ(name, "O_", 2)) {
102             if (strEQ(name, "O_CREAT"))
103 #ifdef O_CREAT
104                 return O_CREAT;
105 #else
106                 goto not_there;
107 #endif
108             if (strEQ(name, "O_EXCL"))
109 #ifdef O_EXCL
110                 return O_EXCL;
111 #else
112                 goto not_there;
113 #endif
114             if (strEQ(name, "O_NOCTTY"))
115 #ifdef O_NOCTTY
116                 return O_NOCTTY;
117 #else
118                 goto not_there;
119 #endif
120             if (strEQ(name, "O_TRUNC"))
121 #ifdef O_TRUNC
122                 return O_TRUNC;
123 #else
124                 goto not_there;
125 #endif
126             if (strEQ(name, "O_APPEND"))
127 #ifdef O_APPEND
128                 return O_APPEND;
129 #else
130                 goto not_there;
131 #endif
132             if (strEQ(name, "O_NONBLOCK"))
133 #ifdef O_NONBLOCK
134                 return O_NONBLOCK;
135 #else
136                 goto not_there;
137 #endif
138             if (strEQ(name, "O_NDELAY"))
139 #ifdef O_NDELAY
140                 return O_NDELAY;
141 #else
142                 goto not_there;
143 #endif
144             if (strEQ(name, "O_RDONLY"))
145 #ifdef O_RDONLY
146                 return O_RDONLY;
147 #else
148                 goto not_there;
149 #endif
150             if (strEQ(name, "O_RDWR"))
151 #ifdef O_RDWR
152                 return O_RDWR;
153 #else
154                 goto not_there;
155 #endif
156             if (strEQ(name, "O_WRONLY"))
157 #ifdef O_WRONLY
158                 return O_WRONLY;
159 #else
160                 goto not_there;
161 #endif
162         } else
163           goto not_there;
164         break;
165     }
166     errno = EINVAL;
167     return 0;
168
169 not_there:
170     errno = ENOENT;
171     return 0;
172 }
173
174
175 MODULE = Fcntl          PACKAGE = Fcntl
176
177 double
178 constant(name,arg)
179         char *          name
180         int             arg
181