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