This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fcntl: more O_ constants, move SEEK_ to @EXPORT_OK
[perl5.git] / ext / Fcntl / Fcntl.xs
CommitLineData
c5be433b 1#define PERL_NO_GET_CONTEXT
a0d0e21e
LW
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
5
75ced34b
PP
6#ifdef VMS
7# include <file.h>
8#else
cd661bb6
NIS
9#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
10#define _NO_OLDNAMES
11#endif
75ced34b 12# include <fcntl.h>
cd661bb6
NIS
13#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
14#undef _NO_OLDNAMES
15#endif
75ced34b 16#endif
a0d0e21e 17
ac88732c
JH
18#ifdef I_UNISTD
19#include <unistd.h>
20#endif
21
8e07c86e
AD
22/* This comment is a kludge to get metaconfig to see the symbols
23 VAL_O_NONBLOCK
24 VAL_EAGAIN
25 RD_NODATA
26 EOF_NONBLOCK
27 and include the appropriate metaconfig unit
28 so that Configure will test how to turn on non-blocking I/O
29 for a file descriptor. See config.h for how to use these
30 in your extension.
31
32 While I'm at it, I'll have metaconfig look for HAS_POLL too.
33 --AD October 16, 1995
34*/
35
a0d0e21e 36static int
f0f333f4 37not_here(char *s)
a0d0e21e
LW
38{
39 croak("%s not implemented on this architecture", s);
40 return -1;
41}
42
43static double
f0f333f4 44constant(char *name, int arg)
a0d0e21e
LW
45{
46 errno = 0;
47 switch (*name) {
ca6e1c26
JH
48 case '_':
49 if (strEQ(name, "_S_IFMT")) /* Yes, _S_IFMT. */
50#ifdef S_IFMT
51 return S_IFMT;
52#else
53 goto not_there;
54#endif
55 break;
a0d0e21e
LW
56 case 'F':
57 if (strnEQ(name, "F_", 2)) {
ac88732c
JH
58 if (strEQ(name, "F_ALLOCSP"))
59#ifdef F_ALLOCSP
60 return F_ALLOCSP;
61#else
62 goto not_there;
63#endif
64 if (strEQ(name, "F_ALLOCSP64"))
65#ifdef F_ALLOCSP64
66 return F_ALLOCSP64;
67#else
68 goto not_there;
69#endif
70 if (strEQ(name, "F_COMPAT"))
71#ifdef F_COMPAT
72 return F_COMPAT;
73#else
74 goto not_there;
75#endif
76 if (strEQ(name, "F_DUP2FD"))
77#ifdef F_DUP2FD
78 return F_DUP2FD;
79#else
80 goto not_there;
81#endif
a0d0e21e
LW
82 if (strEQ(name, "F_DUPFD"))
83#ifdef F_DUPFD
84 return F_DUPFD;
85#else
86 goto not_there;
87#endif
0fd60c2a
JH
88 if (strEQ(name, "F_EXLCK"))
89#ifdef F_EXLCK
90 return F_EXLCK;
91#else
92 goto not_there;
93#endif
ac88732c
JH
94 if (strEQ(name, "F_FREESP"))
95#ifdef F_FREESP
96 return F_FREESP;
97#else
98 goto not_there;
99#endif
100 if (strEQ(name, "F_FREESP64"))
101#ifdef F_FREESP64
102 return F_FREESP64;
103#else
104 goto not_there;
105#endif
106 if (strEQ(name, "F_FSYNC"))
107#ifdef F_FSYNC
108 return F_FSYNC;
109#else
110 goto not_there;
111#endif
112 if (strEQ(name, "F_FSYNC64"))
113#ifdef F_FSYNC64
114 return F_FSYNC64;
115#else
116 goto not_there;
117#endif
a0d0e21e
LW
118 if (strEQ(name, "F_GETFD"))
119#ifdef F_GETFD
120 return F_GETFD;
121#else
122 goto not_there;
123#endif
0fd60c2a
JH
124 if (strEQ(name, "F_GETFL"))
125#ifdef F_GETFL
126 return F_GETFL;
127#else
128 goto not_there;
129#endif
a0d0e21e
LW
130 if (strEQ(name, "F_GETLK"))
131#ifdef F_GETLK
132 return F_GETLK;
133#else
134 goto not_there;
135#endif
5ff3f7a4
GS
136 if (strEQ(name, "F_GETLK64"))
137#ifdef F_GETLK64
138 return F_GETLK64;
139#else
140 goto not_there;
141#endif
5f832ef3
JH
142 if (strEQ(name, "F_GETOWN"))
143#ifdef F_GETOWN
144 return F_GETOWN;
145#else
146 goto not_there;
147#endif
ac88732c
JH
148 if (strEQ(name, "F_NODNY"))
149#ifdef F_NODNY
150 return F_NODNY;
151#else
152 goto not_there;
153#endif
0fd60c2a
JH
154 if (strEQ(name, "F_POSIX"))
155#ifdef F_POSIX
156 return F_POSIX;
a0d0e21e
LW
157#else
158 goto not_there;
159#endif
ac88732c
JH
160 if (strEQ(name, "F_RDACC"))
161#ifdef F_RDACC
162 return F_RDACC;
163#else
164 goto not_there;
165#endif
166 if (strEQ(name, "F_RDDNY"))
167#ifdef F_RDDNY
168 return F_RDDNY;
169#else
170 goto not_there;
171#endif
0fd60c2a
JH
172 if (strEQ(name, "F_RDLCK"))
173#ifdef F_RDLCK
174 return F_RDLCK;
a0d0e21e
LW
175#else
176 goto not_there;
177#endif
ac88732c
JH
178 if (strEQ(name, "F_RWACC"))
179#ifdef F_RWACC
180 return F_RWACC;
181#else
182 goto not_there;
183#endif
184 if (strEQ(name, "F_RWDNY"))
185#ifdef F_RWDNY
186 return F_RWDNY;
187#else
188 goto not_there;
189#endif
0fd60c2a
JH
190 if (strEQ(name, "F_SETFD"))
191#ifdef F_SETFD
192 return F_SETFD;
3e3baf6d
TB
193#else
194 goto not_there;
195#endif
232e078e
AD
196 if (strEQ(name, "F_SETFL"))
197#ifdef F_SETFL
198 return F_SETFL;
a0d0e21e
LW
199#else
200 goto not_there;
201#endif
d9fde92e
GS
202 if (strEQ(name, "F_SETLK"))
203#ifdef F_SETLK
204 return F_SETLK;
205#else
206 goto not_there;
207#endif
5ff3f7a4
GS
208 if (strEQ(name, "F_SETLK64"))
209#ifdef F_SETLK64
210 return F_SETLK64;
a0d0e21e
LW
211#else
212 goto not_there;
213#endif
214 if (strEQ(name, "F_SETLKW"))
215#ifdef F_SETLKW
216 return F_SETLKW;
217#else
218 goto not_there;
219#endif
5ff3f7a4
GS
220 if (strEQ(name, "F_SETLKW64"))
221#ifdef F_SETLKW64
222 return F_SETLKW64;
223#else
224 goto not_there;
225#endif
5f832ef3
JH
226 if (strEQ(name, "F_SETOWN"))
227#ifdef F_SETOWN
228 return F_SETOWN;
229#else
230 goto not_there;
231#endif
ac88732c
JH
232 if (strEQ(name, "F_SHARE"))
233#ifdef F_SHARE
234 return F_SHARE;
235#else
236 goto not_there;
237#endif
0fd60c2a
JH
238 if (strEQ(name, "F_SHLCK"))
239#ifdef F_SHLCK
240 return F_SHLCK;
a0d0e21e
LW
241#else
242 goto not_there;
243#endif
244 if (strEQ(name, "F_UNLCK"))
245#ifdef F_UNLCK
246 return F_UNLCK;
247#else
248 goto not_there;
249#endif
ac88732c
JH
250 if (strEQ(name, "F_UNSHARE"))
251#ifdef F_UNSHARE
252 return F_UNSHARE;
253#else
254 goto not_there;
255#endif
256 if (strEQ(name, "F_WRACC"))
257#ifdef F_WRACC
258 return F_WRACC;
259#else
260 goto not_there;
261#endif
262 if (strEQ(name, "F_WRDNY"))
263#ifdef F_WRDNY
264 return F_WRDNY;
265#else
266 goto not_there;
267#endif
a0d0e21e
LW
268 if (strEQ(name, "F_WRLCK"))
269#ifdef F_WRLCK
270 return F_WRLCK;
271#else
272 goto not_there;
273#endif
274 errno = EINVAL;
275 return 0;
3e3baf6d
TB
276 }
277 if (strEQ(name, "FAPPEND"))
278#ifdef FAPPEND
279 return FAPPEND;
280#else
281 goto not_there;
282#endif
283 if (strEQ(name, "FASYNC"))
284#ifdef FASYNC
285 return FASYNC;
286#else
287 goto not_there;
288#endif
289 if (strEQ(name, "FCREAT"))
290#ifdef FCREAT
291 return FCREAT;
292#else
293 goto not_there;
294#endif
295 if (strEQ(name, "FD_CLOEXEC"))
a0d0e21e
LW
296#ifdef FD_CLOEXEC
297 return FD_CLOEXEC;
298#else
299 goto not_there;
300#endif
0fd60c2a
JH
301 if (strEQ(name, "FDEFER"))
302#ifdef FDEFER
303 return FDEFER;
304#else
305 goto not_there;
306#endif
ac88732c
JH
307 if (strEQ(name, "FDSYNC"))
308#ifdef FDSYNC
309 return FDSYNC;
310#else
311 goto not_there;
312#endif
3e3baf6d
TB
313 if (strEQ(name, "FEXCL"))
314#ifdef FEXCL
315 return FEXCL;
316#else
317 goto not_there;
318#endif
ac88732c
JH
319 if (strEQ(name, "FLARGEFILE"))
320#ifdef FLARGEFILE
321 return FLARGEFILE;
322#else
323 goto not_there;
324#endif
3e3baf6d
TB
325 if (strEQ(name, "FNDELAY"))
326#ifdef FNDELAY
327 return FNDELAY;
328#else
329 goto not_there;
330#endif
331 if (strEQ(name, "FNONBLOCK"))
332#ifdef FNONBLOCK
333 return FNONBLOCK;
334#else
335 goto not_there;
336#endif
ac88732c
JH
337 if (strEQ(name, "FRSYNC"))
338#ifdef FRSYNC
339 return FRSYNC;
340#else
341 goto not_there;
342#endif
3e3baf6d
TB
343 if (strEQ(name, "FSYNC"))
344#ifdef FSYNC
345 return FSYNC;
346#else
347 goto not_there;
348#endif
349 if (strEQ(name, "FTRUNC"))
350#ifdef FTRUNC
351 return FTRUNC;
352#else
353 goto not_there;
354#endif
a0d0e21e 355 break;
7e1af8bc
PP
356 case 'L':
357 if (strnEQ(name, "LOCK_", 5)) {
358 /* We support flock() on systems which don't have it, so
359 always supply the constants. */
360 if (strEQ(name, "LOCK_SH"))
361#ifdef LOCK_SH
362 return LOCK_SH;
363#else
364 return 1;
365#endif
366 if (strEQ(name, "LOCK_EX"))
367#ifdef LOCK_EX
368 return LOCK_EX;
369#else
370 return 2;
371#endif
372 if (strEQ(name, "LOCK_NB"))
373#ifdef LOCK_NB
374 return LOCK_NB;
375#else
376 return 4;
377#endif
378 if (strEQ(name, "LOCK_UN"))
379#ifdef LOCK_UN
380 return LOCK_UN;
381#else
382 return 8;
383#endif
384 } else
385 goto not_there;
386 break;
a0d0e21e
LW
387 case 'O':
388 if (strnEQ(name, "O_", 2)) {
0fd60c2a
JH
389 if (strEQ(name, "O_ACCMODE"))
390#ifdef O_ACCMODE
391 return O_ACCMODE;
392#else
393 goto not_there;
394#endif
395 if (strEQ(name, "O_APPEND"))
396#ifdef O_APPEND
397 return O_APPEND;
398#else
399 goto not_there;
400#endif
401 if (strEQ(name, "O_ASYNC"))
402#ifdef O_ASYNC
403 return O_ASYNC;
404#else
405 goto not_there;
406#endif
407 if (strEQ(name, "O_BINARY"))
408#ifdef O_BINARY
409 return O_BINARY;
410#else
411 goto not_there;
412#endif
a0d0e21e
LW
413 if (strEQ(name, "O_CREAT"))
414#ifdef O_CREAT
415 return O_CREAT;
416#else
417 goto not_there;
418#endif
0fd60c2a
JH
419 if (strEQ(name, "O_DEFER"))
420#ifdef O_DEFER
421 return O_DEFER;
422#else
423 goto not_there;
424#endif
ca6e1c26
JH
425 if (strEQ(name, "O_DIRECT"))
426#ifdef O_DIRECT
427 return O_DIRECT;
428#else
429 goto not_there;
430#endif
431 if (strEQ(name, "O_DIRECTORY"))
432#ifdef O_DIRECTORY
433 return O_DIRECTORY;
434#else
435 goto not_there;
436#endif
0fd60c2a
JH
437 if (strEQ(name, "O_DSYNC"))
438#ifdef O_DSYNC
439 return O_DSYNC;
440#else
441 goto not_there;
442#endif
a0d0e21e
LW
443 if (strEQ(name, "O_EXCL"))
444#ifdef O_EXCL
445 return O_EXCL;
446#else
447 goto not_there;
448#endif
0fd60c2a
JH
449 if (strEQ(name, "O_EXLOCK"))
450#ifdef O_EXLOCK
451 return O_EXLOCK;
a0d0e21e
LW
452#else
453 goto not_there;
454#endif
5ff3f7a4
GS
455 if (strEQ(name, "O_LARGEFILE"))
456#ifdef O_LARGEFILE
457 return O_LARGEFILE;
458#else
459 goto not_there;
460#endif
0fd60c2a
JH
461 if (strEQ(name, "O_NDELAY"))
462#ifdef O_NDELAY
463 return O_NDELAY;
a0d0e21e
LW
464#else
465 goto not_there;
466#endif
0fd60c2a
JH
467 if (strEQ(name, "O_NOCTTY"))
468#ifdef O_NOCTTY
469 return O_NOCTTY;
a0d0e21e
LW
470#else
471 goto not_there;
472#endif
ca6e1c26
JH
473 if (strEQ(name, "O_NOFOLLOW"))
474#ifdef O_NOFOLLOW
475 return O_NOFOLLOW;
476#else
477 goto not_there;
478#endif
a0d0e21e
LW
479 if (strEQ(name, "O_NONBLOCK"))
480#ifdef O_NONBLOCK
481 return O_NONBLOCK;
482#else
483 goto not_there;
484#endif
a0d0e21e
LW
485 if (strEQ(name, "O_RDONLY"))
486#ifdef O_RDONLY
487 return O_RDONLY;
488#else
489 goto not_there;
490#endif
491 if (strEQ(name, "O_RDWR"))
492#ifdef O_RDWR
493 return O_RDWR;
494#else
495 goto not_there;
496#endif
0fd60c2a
JH
497 if (strEQ(name, "O_RSYNC"))
498#ifdef O_RSYNC
499 return O_RSYNC;
705af498
JH
500#else
501 goto not_there;
502#endif
503 if (strEQ(name, "O_SHLOCK"))
504#ifdef O_SHLOCK
505 return O_SHLOCK;
506#else
507 goto not_there;
508#endif
0fd60c2a
JH
509 if (strEQ(name, "O_SYNC"))
510#ifdef O_SYNC
511 return O_SYNC;
705af498
JH
512#else
513 goto not_there;
514#endif
ca6e1c26
JH
515 if (strEQ(name, "O_TEMPORARY"))
516#ifdef O_TEMPORARY
517 return O_TEMPORARY;
518#else
519 goto not_there;
520#endif
0fd60c2a
JH
521 if (strEQ(name, "O_TEXT"))
522#ifdef O_TEXT
523 return O_TEXT;
705af498
JH
524#else
525 goto not_there;
526#endif
0fd60c2a
JH
527 if (strEQ(name, "O_TRUNC"))
528#ifdef O_TRUNC
529 return O_TRUNC;
705af498
JH
530#else
531 goto not_there;
532#endif
0fd60c2a
JH
533 if (strEQ(name, "O_WRONLY"))
534#ifdef O_WRONLY
535 return O_WRONLY;
705af498
JH
536#else
537 goto not_there;
538#endif
cd39f2b6
JH
539 if (strEQ(name, "O_ALIAS"))
540#ifdef O_ALIAS
541 return O_ALIAS;
542#else
543 goto not_there;
544#endif
545 if (strEQ(name, "O_RSRC"))
546#ifdef O_RSRC
547 return O_RSRC;
548#else
549 goto not_there;
550#endif
a0d0e21e
LW
551 } else
552 goto not_there;
553 break;
ac88732c 554 case 'S':
ca6e1c26
JH
555 switch (name[1]) {
556 case '_':
557 if (strEQ(name, "S_ISUID"))
558#ifdef S_ISUID
559 return S_ISUID;
560#else
561 goto not_there;
562#endif
563 if (strEQ(name, "S_ISGID"))
564#ifdef S_ISGID
565 return S_ISGID;
566#else
567 goto not_there;
568#endif
569 if (strEQ(name, "S_ISVTX"))
570#ifdef S_ISVTX
571 return S_ISVTX;
572#else
573 goto not_there;
574#endif
575 if (strEQ(name, "S_ISTXT"))
576#ifdef S_ISTXT
577 return S_ISTXT;
578#else
579 goto not_there;
580#endif
581 if (strEQ(name, "S_IFREG"))
582#ifdef S_IFREG
583 return S_IFREG;
584#else
585 goto not_there;
586#endif
587 if (strEQ(name, "S_IFDIR"))
588#ifdef S_IFDIR
589 return S_IFDIR;
590#else
591 goto not_there;
592#endif
593 if (strEQ(name, "S_IFLNK"))
594#ifdef S_IFLNK
595 return S_IFLNK;
596#else
597 goto not_there;
598#endif
599 if (strEQ(name, "S_IFSOCK"))
600#ifdef S_IFSOCK
601 return S_IFSOCK;
602#else
603 goto not_there;
604#endif
605 if (strEQ(name, "S_IFBLK"))
606#ifdef S_IFBLK
607 return S_IFBLK;
608#else
609 goto not_there;
610#endif
611 if (strEQ(name, "S_IFCHR"))
612#ifdef S_IFCHR
613 return S_IFCHR;
614#else
615 goto not_there;
616#endif
617 if (strEQ(name, "S_IFIFO"))
618#ifdef S_IFIFO
619 return S_IFIFO;
620#else
621 goto not_there;
622#endif
623 if (strEQ(name, "S_IFWHT"))
624#ifdef S_IFWHT
625 return S_IFWHT;
626#else
627 goto not_there;
628#endif
629 if (strEQ(name, "S_ENFMT"))
630#ifdef S_ENFMT
631 return S_ENFMT;
632#else
633 goto not_there;
634#endif
635 if (strEQ(name, "S_IRUSR"))
636#ifdef S_IRUSR
637 return S_IRUSR;
638#else
639 goto not_there;
640#endif
641 if (strEQ(name, "S_IWUSR"))
642#ifdef S_IWUSR
643 return S_IWUSR;
644#else
645 goto not_there;
646#endif
647 if (strEQ(name, "S_IXUSR"))
648#ifdef S_IXUSR
649 return S_IXUSR;
650#else
651 goto not_there;
652#endif
653 if (strEQ(name, "S_IRWXU"))
654#ifdef S_IRWXU
655 return S_IRWXU;
656#else
657 goto not_there;
658#endif
659 if (strEQ(name, "S_IRGRP"))
660#ifdef S_IRGRP
661 return S_IRGRP;
662#else
663 goto not_there;
664#endif
665 if (strEQ(name, "S_IWGRP"))
666#ifdef S_IWGRP
667 return S_IWGRP;
668#else
669 goto not_there;
670#endif
671 if (strEQ(name, "S_IXGRP"))
672#ifdef S_IXGRP
673 return S_IXGRP;
674#else
675 goto not_there;
676#endif
677 if (strEQ(name, "S_IRWXG"))
678#ifdef S_IRWXG
679 return S_IRWXG;
680#else
681 goto not_there;
682#endif
683 if (strEQ(name, "S_IROTH"))
684#ifdef S_IROTH
685 return S_IROTH;
686#else
687 goto not_there;
688#endif
689 if (strEQ(name, "S_IWOTH"))
690#ifdef S_IWOTH
691 return S_IWOTH;
692#else
693 goto not_there;
694#endif
695 if (strEQ(name, "S_IXOTH"))
696#ifdef S_IXOTH
697 return S_IXOTH;
698#else
699 goto not_there;
700#endif
701 if (strEQ(name, "S_IRWXO"))
702#ifdef S_IRWXO
703 return S_IRWXO;
704#else
705 goto not_there;
706#endif
707 if (strEQ(name, "S_IREAD"))
708#ifdef S_IREAD
709 return S_IREAD;
710#else
711 goto not_there;
712#endif
713 if (strEQ(name, "S_IWRITE"))
714#ifdef S_IWRITE
715 return S_IWRITE;
716#else
717 goto not_there;
718#endif
719 if (strEQ(name, "S_IEXEC"))
720#ifdef S_IEXEC
721 return S_IEXEC;
722#else
723 goto not_there;
724#endif
725 break;
726 case 'E':
727 if (strEQ(name, "SEEK_CUR"))
ac88732c 728#ifdef SEEK_CUR
ca6e1c26 729 return SEEK_CUR;
ac88732c 730#else
ca6e1c26 731 return 1;
ac88732c 732#endif
ca6e1c26 733 if (strEQ(name, "SEEK_END"))
ac88732c 734#ifdef SEEK_END
ca6e1c26 735 return SEEK_END;
ac88732c 736#else
ca6e1c26 737 return 2;
ac88732c 738#endif
ca6e1c26 739 if (strEQ(name, "SEEK_SET"))
ac88732c 740#ifdef SEEK_SET
ca6e1c26 741 return SEEK_SET;
ac88732c 742#else
ca6e1c26 743 return 0;
ac88732c 744#endif
ca6e1c26
JH
745 break;
746 }
a0d0e21e
LW
747 }
748 errno = EINVAL;
749 return 0;
750
751not_there:
752 errno = ENOENT;
753 return 0;
754}
755
756
757MODULE = Fcntl PACKAGE = Fcntl
758
759double
760constant(name,arg)
761 char * name
762 int arg
763