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
1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5
6 #ifdef VMS
7 #  include <file.h>
8 #else
9 #if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
10 #define _NO_OLDNAMES
11 #endif 
12 #  include <fcntl.h>
13 #if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
14 #undef _NO_OLDNAMES
15 #endif 
16 #endif
17
18 #ifdef I_UNISTD
19 #include <unistd.h>
20 #endif
21
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
36 static int
37 not_here(char *s)
38 {
39     croak("%s not implemented on this architecture", s);
40     return -1;
41 }
42
43 static double
44 constant(char *name, int arg)
45 {
46     errno = 0;
47     switch (*name) {
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;
56     case 'F':
57         if (strnEQ(name, "F_", 2)) {
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
82             if (strEQ(name, "F_DUPFD"))
83 #ifdef F_DUPFD
84                 return F_DUPFD;
85 #else
86                 goto not_there;
87 #endif
88             if (strEQ(name, "F_EXLCK"))
89 #ifdef F_EXLCK
90                 return F_EXLCK;
91 #else
92                 goto not_there;
93 #endif
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
118             if (strEQ(name, "F_GETFD"))
119 #ifdef F_GETFD
120                 return F_GETFD;
121 #else
122                 goto not_there;
123 #endif
124             if (strEQ(name, "F_GETFL"))
125 #ifdef F_GETFL
126                 return F_GETFL;
127 #else
128                 goto not_there;
129 #endif
130             if (strEQ(name, "F_GETLK"))
131 #ifdef F_GETLK
132                 return F_GETLK;
133 #else
134                 goto not_there;
135 #endif
136             if (strEQ(name, "F_GETLK64"))
137 #ifdef F_GETLK64
138                 return F_GETLK64;
139 #else
140                 goto not_there;
141 #endif
142             if (strEQ(name, "F_GETOWN"))
143 #ifdef F_GETOWN
144                 return F_GETOWN;
145 #else
146                 goto not_there;
147 #endif
148             if (strEQ(name, "F_NODNY"))
149 #ifdef F_NODNY
150                 return F_NODNY;
151 #else
152                 goto not_there;
153 #endif
154             if (strEQ(name, "F_POSIX"))
155 #ifdef F_POSIX
156                 return F_POSIX;
157 #else
158                 goto not_there;
159 #endif
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
172             if (strEQ(name, "F_RDLCK"))
173 #ifdef F_RDLCK
174                 return F_RDLCK;
175 #else
176                 goto not_there;
177 #endif
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
190             if (strEQ(name, "F_SETFD"))
191 #ifdef F_SETFD
192                 return F_SETFD;
193 #else
194                 goto not_there;
195 #endif
196             if (strEQ(name, "F_SETFL"))
197 #ifdef F_SETFL
198                 return F_SETFL;
199 #else
200                 goto not_there;
201 #endif
202             if (strEQ(name, "F_SETLK"))
203 #ifdef F_SETLK
204                 return F_SETLK;
205 #else
206                 goto not_there;
207 #endif
208             if (strEQ(name, "F_SETLK64"))
209 #ifdef F_SETLK64
210                 return F_SETLK64;
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
220             if (strEQ(name, "F_SETLKW64"))
221 #ifdef F_SETLKW64
222                 return F_SETLKW64;
223 #else
224                 goto not_there;
225 #endif
226             if (strEQ(name, "F_SETOWN"))
227 #ifdef F_SETOWN
228                 return F_SETOWN;
229 #else
230                 goto not_there;
231 #endif
232             if (strEQ(name, "F_SHARE"))
233 #ifdef F_SHARE
234                 return F_SHARE;
235 #else
236                 goto not_there;
237 #endif
238             if (strEQ(name, "F_SHLCK"))
239 #ifdef F_SHLCK
240                 return F_SHLCK;
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
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
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;
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"))
296 #ifdef FD_CLOEXEC
297             return FD_CLOEXEC;
298 #else
299             goto not_there;
300 #endif
301         if (strEQ(name, "FDEFER"))
302 #ifdef FDEFER
303             return FDEFER;
304 #else
305             goto not_there;
306 #endif
307         if (strEQ(name, "FDSYNC"))
308 #ifdef FDSYNC
309             return FDSYNC;
310 #else
311             goto not_there;
312 #endif
313         if (strEQ(name, "FEXCL"))
314 #ifdef FEXCL
315             return FEXCL;
316 #else
317             goto not_there;
318 #endif
319         if (strEQ(name, "FLARGEFILE"))
320 #ifdef FLARGEFILE
321             return FLARGEFILE;
322 #else
323             goto not_there;
324 #endif
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
337         if (strEQ(name, "FRSYNC"))
338 #ifdef FRSYNC
339             return FRSYNC;
340 #else
341             goto not_there;
342 #endif
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
355         break;
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;
387     case 'O':
388         if (strnEQ(name, "O_", 2)) {
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
413             if (strEQ(name, "O_CREAT"))
414 #ifdef O_CREAT
415                 return O_CREAT;
416 #else
417                 goto not_there;
418 #endif
419             if (strEQ(name, "O_DEFER"))
420 #ifdef O_DEFER
421                 return O_DEFER;
422 #else
423                 goto not_there;
424 #endif
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
437             if (strEQ(name, "O_DSYNC"))
438 #ifdef O_DSYNC
439                 return O_DSYNC;
440 #else
441                 goto not_there;
442 #endif
443             if (strEQ(name, "O_EXCL"))
444 #ifdef O_EXCL
445                 return O_EXCL;
446 #else
447                 goto not_there;
448 #endif
449             if (strEQ(name, "O_EXLOCK"))
450 #ifdef O_EXLOCK
451                 return O_EXLOCK;
452 #else
453                 goto not_there;
454 #endif
455             if (strEQ(name, "O_LARGEFILE"))
456 #ifdef O_LARGEFILE
457                 return O_LARGEFILE;
458 #else
459                 goto not_there;
460 #endif
461             if (strEQ(name, "O_NDELAY"))
462 #ifdef O_NDELAY
463                 return O_NDELAY;
464 #else
465                 goto not_there;
466 #endif
467             if (strEQ(name, "O_NOCTTY"))
468 #ifdef O_NOCTTY
469                 return O_NOCTTY;
470 #else
471                 goto not_there;
472 #endif
473             if (strEQ(name, "O_NOFOLLOW"))
474 #ifdef O_NOFOLLOW
475                 return O_NOFOLLOW;
476 #else
477                 goto not_there;
478 #endif
479             if (strEQ(name, "O_NONBLOCK"))
480 #ifdef O_NONBLOCK
481                 return O_NONBLOCK;
482 #else
483                 goto not_there;
484 #endif
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
497             if (strEQ(name, "O_RSYNC"))
498 #ifdef O_RSYNC
499                 return O_RSYNC;
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
509             if (strEQ(name, "O_SYNC"))
510 #ifdef O_SYNC
511                 return O_SYNC;
512 #else
513                 goto not_there;
514 #endif
515             if (strEQ(name, "O_TEMPORARY"))
516 #ifdef O_TEMPORARY
517                 return O_TEMPORARY;
518 #else
519                 goto not_there;
520 #endif
521             if (strEQ(name, "O_TEXT"))
522 #ifdef O_TEXT
523                 return O_TEXT;
524 #else
525                 goto not_there;
526 #endif
527             if (strEQ(name, "O_TRUNC"))
528 #ifdef O_TRUNC
529                 return O_TRUNC;
530 #else
531                 goto not_there;
532 #endif
533             if (strEQ(name, "O_WRONLY"))
534 #ifdef O_WRONLY
535                 return O_WRONLY;
536 #else
537                 goto not_there;
538 #endif
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
551         } else
552           goto not_there;
553         break;
554     case 'S':
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"))
728 #ifdef SEEK_CUR
729             return SEEK_CUR;
730 #else
731             return 1;
732 #endif
733         if (strEQ(name, "SEEK_END"))
734 #ifdef SEEK_END
735             return SEEK_END;
736 #else
737             return 2;
738 #endif
739         if (strEQ(name, "SEEK_SET"))
740 #ifdef SEEK_SET
741             return SEEK_SET;
742 #else
743             return 0;
744 #endif
745         break;
746       }    
747     }
748     errno = EINVAL;
749     return 0;
750
751 not_there:
752     errno = ENOENT;
753     return 0;
754 }
755
756
757 MODULE = Fcntl          PACKAGE = Fcntl
758
759 double
760 constant(name,arg)
761         char *          name
762         int             arg
763