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 void
XS_Fcntl_S_ISREG(pTHX_ CV * cv)37 XS_Fcntl_S_ISREG(pTHX_ CV* cv)
38 {
39 dXSARGS;
40 dXSI32;
41 /* Preserve the semantics of the perl code, which was:
42 sub S_ISREG { ( $_[0] & _S_IFMT() ) == S_IFREG() }
43 */
44 SV *mode;
45
46 PERL_UNUSED_VAR(cv); /* -W */
47 SP -= items;
48
49 if (items > 0)
50 mode = ST(0);
51 else {
52 mode = &PL_sv_undef;
53 EXTEND(SP, 1);
54 }
55 PUSHs(((SvUV(mode) & S_IFMT) == (UV)ix) ? &PL_sv_yes : &PL_sv_no);
56 PUTBACK;
57 }
58
59 #include "const-c.inc"
60
61 MODULE = Fcntl PACKAGE = Fcntl
62
63 INCLUDE: const-xs.inc
64
65 void
66 S_IMODE(...)
67 PREINIT:
68 dXSTARG;
69 SV *mode;
70 PPCODE:
71 if (items > 0)
72 mode = ST(0);
73 else {
74 mode = &PL_sv_undef;
75 EXTEND(SP, 1);
76 }
77 PUSHu(SvUV(mode) & 07777);
78
79 void
80 S_IFMT(...)
81 PREINIT:
82 dXSTARG;
83 PPCODE:
84 PUSHu(items ? (SvUV(ST(0)) & S_IFMT) : S_IFMT);
85
86 BOOT:
87 {
88 CV *cv;
89 #ifdef S_IFREG
90 cv = newXS("Fcntl::S_ISREG", XS_Fcntl_S_ISREG, file);
91 XSANY.any_i32 = S_IFREG;
92 #endif
93 #ifdef S_IFDIR
94 cv = newXS("Fcntl::S_ISDIR", XS_Fcntl_S_ISREG, file);
95 XSANY.any_i32 = S_IFDIR;
96 #endif
97 #ifdef S_IFLNK
98 cv = newXS("Fcntl::S_ISLNK", XS_Fcntl_S_ISREG, file);
99 XSANY.any_i32 = S_IFLNK;
100 #endif
101 #ifdef S_IFSOCK
102 cv = newXS("Fcntl::S_ISSOCK", XS_Fcntl_S_ISREG, file);
103 XSANY.any_i32 = S_IFSOCK;
104 #endif
105 #ifdef S_IFBLK
106 cv = newXS("Fcntl::S_ISBLK", XS_Fcntl_S_ISREG, file);
107 XSANY.any_i32 = S_IFBLK;
108 #endif
109 #ifdef S_IFCHR
110 cv = newXS("Fcntl::S_ISCHR", XS_Fcntl_S_ISREG, file);
111 XSANY.any_i32 = S_IFCHR;
112 #endif
113 #ifdef S_IFIFO
114 cv = newXS("Fcntl::S_ISFIFO", XS_Fcntl_S_ISREG, file);
115 XSANY.any_i32 = S_IFIFO;
116 #endif
117 #ifdef S_IFWHT
118 cv = newXS("Fcntl::S_ISWHT", XS_Fcntl_S_ISREG, file);
119 XSANY.any_i32 = S_IFWHT;
120 #endif
121 #ifdef S_ENFMT
122 cv = newXS("Fcntl::S_ISENFMT", XS_Fcntl_S_ISREG, file);
123 XSANY.any_i32 = S_ENFMT;
124 #endif
125 }
126