This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
[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 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 48 case '_':
8c99d73e 49 if (strEQ(name, "_S_IFMT")) /* Yes, on name _S_IFMT return S_IFMT. */
ca6e1c26
JH
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 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
8c99d73e
GS
479 if (strEQ(name, "O_NOINHERIT"))
480#ifdef O_NOINHERIT
481 return O_NOINHERIT;
482#else
483 goto not_there;
484#endif
a0d0e21e
LW
485 if (strEQ(name, "O_NONBLOCK"))
486#ifdef O_NONBLOCK
487 return O_NONBLOCK;
488#else
489 goto not_there;
490#endif
8c99d73e
GS
491 if (strEQ(name, "O_RANDOM"))
492#ifdef O_RANDOM
493 return O_RANDOM;
494#else
495 goto not_there;
496#endif
497 if (strEQ(name, "O_RAW"))
498#ifdef O_RAW
499 return O_RAW;
500#else
501 goto not_there;
502#endif
a0d0e21e
LW
503 if (strEQ(name, "O_RDONLY"))
504#ifdef O_RDONLY
505 return O_RDONLY;
506#else
507 goto not_there;
508#endif
509 if (strEQ(name, "O_RDWR"))
510#ifdef O_RDWR
511 return O_RDWR;
512#else
513 goto not_there;
514#endif
0fd60c2a
JH
515 if (strEQ(name, "O_RSYNC"))
516#ifdef O_RSYNC
517 return O_RSYNC;
705af498
JH
518#else
519 goto not_there;
520#endif
8c99d73e
GS
521 if (strEQ(name, "O_SEQUENTIAL"))
522#ifdef O_SEQUENTIAL
523 return O_SEQUENTIAL;
524#else
525 goto not_there;
526#endif
705af498
JH
527 if (strEQ(name, "O_SHLOCK"))
528#ifdef O_SHLOCK
529 return O_SHLOCK;
530#else
531 goto not_there;
532#endif
0fd60c2a
JH
533 if (strEQ(name, "O_SYNC"))
534#ifdef O_SYNC
535 return O_SYNC;
705af498
JH
536#else
537 goto not_there;
538#endif
ca6e1c26
JH
539 if (strEQ(name, "O_TEMPORARY"))
540#ifdef O_TEMPORARY
541 return O_TEMPORARY;
542#else
543 goto not_there;
544#endif
0fd60c2a
JH
545 if (strEQ(name, "O_TEXT"))
546#ifdef O_TEXT
547 return O_TEXT;
705af498
JH
548#else
549 goto not_there;
550#endif
0fd60c2a
JH
551 if (strEQ(name, "O_TRUNC"))
552#ifdef O_TRUNC
553 return O_TRUNC;
705af498
JH
554#else
555 goto not_there;
556#endif
0fd60c2a
JH
557 if (strEQ(name, "O_WRONLY"))
558#ifdef O_WRONLY
559 return O_WRONLY;
705af498
JH
560#else
561 goto not_there;
562#endif
cd39f2b6
JH
563 if (strEQ(name, "O_ALIAS"))
564#ifdef O_ALIAS
565 return O_ALIAS;
566#else
567 goto not_there;
568#endif
569 if (strEQ(name, "O_RSRC"))
570#ifdef O_RSRC
571 return O_RSRC;
572#else
573 goto not_there;
574#endif
a0d0e21e
LW
575 } else
576 goto not_there;
577 break;
ac88732c 578 case 'S':
ca6e1c26
JH
579 switch (name[1]) {
580 case '_':
581 if (strEQ(name, "S_ISUID"))
582#ifdef S_ISUID
583 return S_ISUID;
584#else
585 goto not_there;
586#endif
587 if (strEQ(name, "S_ISGID"))
588#ifdef S_ISGID
589 return S_ISGID;
590#else
591 goto not_there;
592#endif
593 if (strEQ(name, "S_ISVTX"))
594#ifdef S_ISVTX
595 return S_ISVTX;
596#else
597 goto not_there;
598#endif
599 if (strEQ(name, "S_ISTXT"))
600#ifdef S_ISTXT
601 return S_ISTXT;
602#else
603 goto not_there;
604#endif
605 if (strEQ(name, "S_IFREG"))
606#ifdef S_IFREG
607 return S_IFREG;
608#else
609 goto not_there;
610#endif
611 if (strEQ(name, "S_IFDIR"))
612#ifdef S_IFDIR
613 return S_IFDIR;
614#else
615 goto not_there;
616#endif
617 if (strEQ(name, "S_IFLNK"))
618#ifdef S_IFLNK
619 return S_IFLNK;
620#else
621 goto not_there;
622#endif
623 if (strEQ(name, "S_IFSOCK"))
624#ifdef S_IFSOCK
625 return S_IFSOCK;
626#else
627 goto not_there;
628#endif
629 if (strEQ(name, "S_IFBLK"))
630#ifdef S_IFBLK
631 return S_IFBLK;
632#else
633 goto not_there;
634#endif
635 if (strEQ(name, "S_IFCHR"))
636#ifdef S_IFCHR
637 return S_IFCHR;
638#else
639 goto not_there;
640#endif
641 if (strEQ(name, "S_IFIFO"))
642#ifdef S_IFIFO
643 return S_IFIFO;
644#else
645 goto not_there;
646#endif
647 if (strEQ(name, "S_IFWHT"))
648#ifdef S_IFWHT
649 return S_IFWHT;
650#else
651 goto not_there;
652#endif
653 if (strEQ(name, "S_ENFMT"))
654#ifdef S_ENFMT
655 return S_ENFMT;
656#else
657 goto not_there;
658#endif
659 if (strEQ(name, "S_IRUSR"))
660#ifdef S_IRUSR
661 return S_IRUSR;
662#else
663 goto not_there;
664#endif
665 if (strEQ(name, "S_IWUSR"))
666#ifdef S_IWUSR
667 return S_IWUSR;
668#else
669 goto not_there;
670#endif
671 if (strEQ(name, "S_IXUSR"))
672#ifdef S_IXUSR
673 return S_IXUSR;
674#else
675 goto not_there;
676#endif
677 if (strEQ(name, "S_IRWXU"))
678#ifdef S_IRWXU
679 return S_IRWXU;
680#else
681 goto not_there;
682#endif
683 if (strEQ(name, "S_IRGRP"))
684#ifdef S_IRGRP
685 return S_IRGRP;
686#else
687 goto not_there;
688#endif
689 if (strEQ(name, "S_IWGRP"))
690#ifdef S_IWGRP
691 return S_IWGRP;
692#else
693 goto not_there;
694#endif
695 if (strEQ(name, "S_IXGRP"))
696#ifdef S_IXGRP
697 return S_IXGRP;
698#else
699 goto not_there;
700#endif
701 if (strEQ(name, "S_IRWXG"))
702#ifdef S_IRWXG
703 return S_IRWXG;
704#else
705 goto not_there;
706#endif
707 if (strEQ(name, "S_IROTH"))
708#ifdef S_IROTH
709 return S_IROTH;
710#else
711 goto not_there;
712#endif
713 if (strEQ(name, "S_IWOTH"))
714#ifdef S_IWOTH
715 return S_IWOTH;
716#else
717 goto not_there;
718#endif
719 if (strEQ(name, "S_IXOTH"))
720#ifdef S_IXOTH
721 return S_IXOTH;
722#else
723 goto not_there;
724#endif
725 if (strEQ(name, "S_IRWXO"))
726#ifdef S_IRWXO
727 return S_IRWXO;
728#else
729 goto not_there;
730#endif
731 if (strEQ(name, "S_IREAD"))
732#ifdef S_IREAD
733 return S_IREAD;
734#else
735 goto not_there;
736#endif
737 if (strEQ(name, "S_IWRITE"))
738#ifdef S_IWRITE
739 return S_IWRITE;
740#else
741 goto not_there;
742#endif
743 if (strEQ(name, "S_IEXEC"))
744#ifdef S_IEXEC
745 return S_IEXEC;
746#else
747 goto not_there;
748#endif
749 break;
750 case 'E':
751 if (strEQ(name, "SEEK_CUR"))
ac88732c 752#ifdef SEEK_CUR
ca6e1c26 753 return SEEK_CUR;
ac88732c 754#else
ca6e1c26 755 return 1;
ac88732c 756#endif
ca6e1c26 757 if (strEQ(name, "SEEK_END"))
ac88732c 758#ifdef SEEK_END
ca6e1c26 759 return SEEK_END;
ac88732c 760#else
ca6e1c26 761 return 2;
ac88732c 762#endif
ca6e1c26 763 if (strEQ(name, "SEEK_SET"))
ac88732c 764#ifdef SEEK_SET
ca6e1c26 765 return SEEK_SET;
ac88732c 766#else
ca6e1c26 767 return 0;
ac88732c 768#endif
ca6e1c26
JH
769 break;
770 }
a0d0e21e
LW
771 }
772 errno = EINVAL;
773 return 0;
774
775not_there:
776 errno = ENOENT;
777 return 0;
778}
779
780
781MODULE = Fcntl PACKAGE = Fcntl
782
783double
784constant(name,arg)
785 char * name
786 int arg
787