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 37 XS_Fcntl_S_ISREG(pTHX_ CV* cv) 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 } 56 PUSHs(((SvUV(mode) & S_IFMT) == (UV)ix) ? &PL_sv_yes : &PL_sv_no); 57 PUTBACK; 58 } 59 60 #include "const-c.inc" 61 62 MODULE = Fcntl PACKAGE = Fcntl 63 64 INCLUDE: const-xs.inc 65 66 void 67 S_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 80 void 81 S_IFMT(...) 82 PREINIT: 83 dXSTARG; 84 PPCODE: 85 PUSHu(items ? (SvUV(ST(0)) & S_IFMT) : S_IFMT); 86 87 BOOT: 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 122 #ifdef S_ENFMT 123 cv = newXS("Fcntl::S_ISENFMT", XS_Fcntl_S_ISREG, file); 124 XSANY.any_i32 = S_ENFMT; 125 #endif 126 } 127