ext/Fcntl/Fcntl.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #ifdef VMS
   6 #  include <file.h>
   7 #else
   8 #  include <fcntl.h>
   9 #endif
  10
  11 /* This comment is a kludge to get metaconfig to see the symbols
  12     VAL_O_NONBLOCK
  13     VAL_EAGAIN
  14     RD_NODATA
  15     EOF_NONBLOCK
  16    and include the appropriate metaconfig unit
  17    so that Configure will test how to turn on non-blocking I/O
  18    for a file descriptor.  See config.h for how to use these
  19    in your extension.
  20
  21    While I'm at it, I'll have metaconfig look for HAS_POLL too.
  22    --AD  October 16, 1995
  23 */
  24
  25 static int
  26 not_here(s)
  27 char *s;
  28 {
  29     croak("%s not implemented on this architecture", s);
  30     return -1;
  31 }
  32
  33 static double
  34 constant(name, arg)
  35 char *name;
  36 int arg;
  37 {
  38     errno = 0;
  39     switch (*name) {
  40     case 'F':
  41         if (strnEQ(name, "F_", 2)) {
  42             if (strEQ(name, "F_DUPFD"))
  43 #ifdef F_DUPFD
  44                 return F_DUPFD;
  45 #else
  46                 goto not_there;
  47 #endif
  48             if (strEQ(name, "F_GETFD"))
  49 #ifdef F_GETFD
  50                 return F_GETFD;
  51 #else
  52                 goto not_there;
  53 #endif
  54             if (strEQ(name, "F_GETLK"))
  55 #ifdef F_GETLK
  56                 return F_GETLK;
  57 #else
  58                 goto not_there;
  59 #endif
  60             if (strEQ(name, "F_SETFD"))
  61 #ifdef F_SETFD
  62                 return F_SETFD;
  63 #else
  64                 goto not_there;
  65 #endif
  66             if (strEQ(name, "F_GETFL"))
  67 #ifdef F_GETFL
  68                 return F_GETFL;
  69 #else
  70                 goto not_there;
  71 #endif
  72             if (strEQ(name, "F_SETFL"))
  73 #ifdef F_SETFL
  74                 return F_SETFL;
  75 #else
  76                 goto not_there;
  77 #endif
  78             if (strEQ(name, "F_SETLK"))
  79 #ifdef F_SETLK
  80                 return F_SETLK;
  81 #else
  82                 goto not_there;
  83 #endif
  84             if (strEQ(name, "F_SETLKW"))
  85 #ifdef F_SETLKW
  86                 return F_SETLKW;
  87 #else
  88                 goto not_there;
  89 #endif
  90             if (strEQ(name, "F_RDLCK"))
  91 #ifdef F_RDLCK
  92                 return F_RDLCK;
  93 #else
  94                 goto not_there;
  95 #endif
  96             if (strEQ(name, "F_UNLCK"))
  97 #ifdef F_UNLCK
  98                 return F_UNLCK;
  99 #else
 100                 goto not_there;
 101 #endif
 102             if (strEQ(name, "F_WRLCK"))
 103 #ifdef F_WRLCK
 104                 return F_WRLCK;
 105 #else
 106                 goto not_there;
 107 #endif
 108             errno = EINVAL;
 109             return 0;
 110         } else
 111           if (strEQ(name, "FD_CLOEXEC"))
 112 #ifdef FD_CLOEXEC
 113             return FD_CLOEXEC;
 114 #else
 115             goto not_there;
 116 #endif
 117         break;
 118     case 'L':
 119         if (strnEQ(name, "LOCK_", 5)) {
 120             /* We support flock() on systems which don't have it, so
 121                always supply the constants. */
 122             if (strEQ(name, "LOCK_SH"))
 123 #ifdef LOCK_SH
 124                 return LOCK_SH;
 125 #else
 126                 return 1;
 127 #endif
 128             if (strEQ(name, "LOCK_EX"))
 129 #ifdef LOCK_EX
 130                 return LOCK_EX;
 131 #else
 132                 return 2;
 133 #endif
 134             if (strEQ(name, "LOCK_NB"))
 135 #ifdef LOCK_NB
 136                 return LOCK_NB;
 137 #else
 138                 return 4;
 139 #endif
 140             if (strEQ(name, "LOCK_UN"))
 141 #ifdef LOCK_UN
 142                 return LOCK_UN;
 143 #else
 144                 return 8;
 145 #endif
 146         } else
 147           goto not_there;
 148         break;
 149     case 'O':
 150         if (strnEQ(name, "O_", 2)) {
 151             if (strEQ(name, "O_CREAT"))
 152 #ifdef O_CREAT
 153                 return O_CREAT;
 154 #else
 155                 goto not_there;
 156 #endif
 157             if (strEQ(name, "O_EXCL"))
 158 #ifdef O_EXCL
 159                 return O_EXCL;
 160 #else
 161                 goto not_there;
 162 #endif
 163             if (strEQ(name, "O_NOCTTY"))
 164 #ifdef O_NOCTTY
 165                 return O_NOCTTY;
 166 #else
 167                 goto not_there;
 168 #endif
 169             if (strEQ(name, "O_TRUNC"))
 170 #ifdef O_TRUNC
 171                 return O_TRUNC;
 172 #else
 173                 goto not_there;
 174 #endif
 175             if (strEQ(name, "O_APPEND"))
 176 #ifdef O_APPEND
 177                 return O_APPEND;
 178 #else
 179                 goto not_there;
 180 #endif
 181             if (strEQ(name, "O_NONBLOCK"))
 182 #ifdef O_NONBLOCK
 183                 return O_NONBLOCK;
 184 #else
 185                 goto not_there;
 186 #endif
 187             if (strEQ(name, "O_NDELAY"))
 188 #ifdef O_NDELAY
 189                 return O_NDELAY;
 190 #else
 191                 goto not_there;
 192 #endif
 193             if (strEQ(name, "O_RDONLY"))
 194 #ifdef O_RDONLY
 195                 return O_RDONLY;
 196 #else
 197                 goto not_there;
 198 #endif
 199             if (strEQ(name, "O_RDWR"))
 200 #ifdef O_RDWR
 201                 return O_RDWR;
 202 #else
 203                 goto not_there;
 204 #endif
 205             if (strEQ(name, "O_WRONLY"))
 206 #ifdef O_WRONLY
 207                 return O_WRONLY;
 208 #else
 209                 goto not_there;
 210 #endif
 211             if (strEQ(name, "O_BINARY"))
 212 #ifdef O_BINARY
 213                 return O_BINARY;
 214 #else
 215                 goto not_there;
 216 #endif
 217             if (strEQ(name, "O_EXLOCK"))
 218 #ifdef O_EXLOCK
 219                 return O_EXLOCK;
 220 #else
 221                 goto not_there;
 222 #endif
 223             if (strEQ(name, "O_SHLOCK"))
 224 #ifdef O_SHLOCK
 225                 return O_SHLOCK;
 226 #else
 227                 goto not_there;
 228 #endif
 229             if (strEQ(name, "O_ASYNC"))
 230 #ifdef O_ASYNC
 231                 return O_ASYNC;
 232 #else
 233                 goto not_there;
 234 #endif
 235             if (strEQ(name, "O_DSYNC"))
 236 #ifdef O_DSYNC
 237                 return O_DSYNC;
 238 #else
 239                 goto not_there;
 240 #endif
 241             if (strEQ(name, "O_RSYNC"))
 242 #ifdef O_RSYNC
 243                 return O_RSYNC;
 244 #else
 245                 goto not_there;
 246 #endif
 247             if (strEQ(name, "O_SYNC"))
 248 #ifdef O_SYNC
 249                 return O_SYNC;
 250 #else
 251                 goto not_there;
 252 #endif
 253             if (strEQ(name, "F_SETOWN"))
 254 #ifdef F_SETOWN
 255                 return F_SETOWN;
 256 #else
 257                 goto not_there;
 258 #endif
 259             if (strEQ(name, "F_GETOWN"))
 260 #ifdef F_GETOWN
 261                 return F_GETOWN;
 262 #else
 263                 goto not_there;
 264 #endif
 265             if (strEQ(name, "O_DEFER"))
 266 #ifdef O_DEFER
 267                 return O_DEFER;
 268 #else
 269                 goto not_there;
 270 #endif
 271         } else
 272           goto not_there;
 273         break;
 274     }
 275     errno = EINVAL;
 276     return 0;
 277
 278 not_there:
 279     errno = ENOENT;
 280     return 0;
 281 }
 282
 283
 284 MODULE = Fcntl          PACKAGE = Fcntl
 285
 286 double
 287 constant(name,arg)
 288         char *          name
 289         int             arg
 290