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