This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: missing E<> POD directive in perlpod.pod
[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;
118 case 'O':
119 if (strnEQ(name, "O_", 2)) {
120 if (strEQ(name, "O_CREAT"))
121#ifdef O_CREAT
122 return O_CREAT;
123#else
124 goto not_there;
125#endif
126 if (strEQ(name, "O_EXCL"))
127#ifdef O_EXCL
128 return O_EXCL;
129#else
130 goto not_there;
131#endif
132 if (strEQ(name, "O_NOCTTY"))
133#ifdef O_NOCTTY
134 return O_NOCTTY;
135#else
136 goto not_there;
137#endif
138 if (strEQ(name, "O_TRUNC"))
139#ifdef O_TRUNC
140 return O_TRUNC;
141#else
142 goto not_there;
143#endif
144 if (strEQ(name, "O_APPEND"))
145#ifdef O_APPEND
146 return O_APPEND;
147#else
148 goto not_there;
149#endif
150 if (strEQ(name, "O_NONBLOCK"))
151#ifdef O_NONBLOCK
152 return O_NONBLOCK;
153#else
154 goto not_there;
155#endif
156 if (strEQ(name, "O_NDELAY"))
157#ifdef O_NDELAY
158 return O_NDELAY;
159#else
160 goto not_there;
161#endif
162 if (strEQ(name, "O_RDONLY"))
163#ifdef O_RDONLY
164 return O_RDONLY;
165#else
166 goto not_there;
167#endif
168 if (strEQ(name, "O_RDWR"))
169#ifdef O_RDWR
170 return O_RDWR;
171#else
172 goto not_there;
173#endif
174 if (strEQ(name, "O_WRONLY"))
175#ifdef O_WRONLY
176 return O_WRONLY;
177#else
178 goto not_there;
179#endif
4633a7c4
LW
180 if (strEQ(name, "O_BINARY"))
181#ifdef O_BINARY
182 return O_BINARY;
183#else
184 goto not_there;
185#endif
a0d0e21e
LW
186 } else
187 goto not_there;
188 break;
189 }
190 errno = EINVAL;
191 return 0;
192
193not_there:
194 errno = ENOENT;
195 return 0;
196}
197
198
199MODULE = Fcntl PACKAGE = Fcntl
200
201double
202constant(name,arg)
203 char * name
204 int arg
205