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 /* This comment is a kludge to get metaconfig to see the symbols
  19     VAL_O_NONBLOCK
  20     VAL_EAGAIN
  21     RD_NODATA
  22     EOF_NONBLOCK
  23    and include the appropriate metaconfig unit
  24    so that Configure will test how to turn on non-blocking I/O
  25    for a file descriptor.  See config.h for how to use these
  26    in your extension.
  27
  28    While I'm at it, I'll have metaconfig look for HAS_POLL too.
  29    --AD  October 16, 1995
  30 */
  31
  32 static int
  33 not_here(char *s)
  34 {
  35     croak("%s not implemented on this architecture", s);
  36     return -1;
  37 }
  38
  39 static double
  40 constant(char *name, int arg)
  41 {
  42     errno = 0;
  43     switch (*name) {
  44     case 'F':
  45         if (strnEQ(name, "F_", 2)) {
  46             if (strEQ(name, "F_DUPFD"))
  47 #ifdef F_DUPFD
  48                 return F_DUPFD;
  49 #else
  50                 goto not_there;
  51 #endif
  52             if (strEQ(name, "F_EXLCK"))
  53 #ifdef F_EXLCK
  54                 return F_EXLCK;
  55 #else
  56                 goto not_there;
  57 #endif
  58             if (strEQ(name, "F_GETFD"))
  59 #ifdef F_GETFD
  60                 return F_GETFD;
  61 #else
  62                 goto not_there;
  63 #endif
  64             if (strEQ(name, "F_GETFL"))
  65 #ifdef F_GETFL
  66                 return F_GETFL;
  67 #else
  68                 goto not_there;
  69 #endif
  70             if (strEQ(name, "F_GETLK"))
  71 #ifdef F_GETLK
  72                 return F_GETLK;
  73 #else
  74                 goto not_there;
  75 #endif
  76             if (strEQ(name, "F_GETLK64"))
  77 #ifdef F_GETLK64
  78                 return F_GETLK64;
  79 #else
  80                 goto not_there;
  81 #endif
  82             if (strEQ(name, "F_GETOWN"))
  83 #ifdef F_GETOWN
  84                 return F_GETOWN;
  85 #else
  86                 goto not_there;
  87 #endif
  88             if (strEQ(name, "F_POSIX"))
  89 #ifdef F_POSIX
  90                 return F_POSIX;
  91 #else
  92                 goto not_there;
  93 #endif
  94             if (strEQ(name, "F_RDLCK"))
  95 #ifdef F_RDLCK
  96                 return F_RDLCK;
  97 #else
  98                 goto not_there;
  99 #endif
 100             if (strEQ(name, "F_SETFD"))
 101 #ifdef F_SETFD
 102                 return F_SETFD;
 103 #else
 104                 goto not_there;
 105 #endif
 106             if (strEQ(name, "F_SETFL"))
 107 #ifdef F_SETFL
 108                 return F_SETFL;
 109 #else
 110                 goto not_there;
 111 #endif
 112             if (strEQ(name, "F_SETLK"))
 113 #ifdef F_SETLK
 114                 return F_SETLK;
 115 #else
 116                 goto not_there;
 117 #endif
 118             if (strEQ(name, "F_SETLK64"))
 119 #ifdef F_SETLK64
 120                 return F_SETLK64;
 121 #else
 122                 goto not_there;
 123 #endif
 124             if (strEQ(name, "F_SETLKW"))
 125 #ifdef F_SETLKW
 126                 return F_SETLKW;
 127 #else
 128                 goto not_there;
 129 #endif
 130             if (strEQ(name, "F_SETLKW64"))
 131 #ifdef F_SETLKW64
 132                 return F_SETLKW64;
 133 #else
 134                 goto not_there;
 135 #endif
 136             if (strEQ(name, "F_SETOWN"))
 137 #ifdef F_SETOWN
 138                 return F_SETOWN;
 139 #else
 140                 goto not_there;
 141 #endif
 142             if (strEQ(name, "F_SHLCK"))
 143 #ifdef F_SHLCK
 144                 return F_SHLCK;
 145 #else
 146                 goto not_there;
 147 #endif
 148             if (strEQ(name, "F_UNLCK"))
 149 #ifdef F_UNLCK
 150                 return F_UNLCK;
 151 #else
 152                 goto not_there;
 153 #endif
 154             if (strEQ(name, "F_WRLCK"))
 155 #ifdef F_WRLCK
 156                 return F_WRLCK;
 157 #else
 158                 goto not_there;
 159 #endif
 160             errno = EINVAL;
 161             return 0;
 162         }
 163         if (strEQ(name, "FAPPEND"))
 164 #ifdef FAPPEND
 165             return FAPPEND;
 166 #else
 167             goto not_there;
 168 #endif
 169         if (strEQ(name, "FASYNC"))
 170 #ifdef FASYNC
 171             return FASYNC;
 172 #else
 173             goto not_there;
 174 #endif
 175         if (strEQ(name, "FCREAT"))
 176 #ifdef FCREAT
 177             return FCREAT;
 178 #else
 179             goto not_there;
 180 #endif
 181         if (strEQ(name, "FD_CLOEXEC"))
 182 #ifdef FD_CLOEXEC
 183             return FD_CLOEXEC;
 184 #else
 185             goto not_there;
 186 #endif
 187         if (strEQ(name, "FDEFER"))
 188 #ifdef FDEFER
 189             return FDEFER;
 190 #else
 191             goto not_there;
 192 #endif
 193         if (strEQ(name, "FEXCL"))
 194 #ifdef FEXCL
 195             return FEXCL;
 196 #else
 197             goto not_there;
 198 #endif
 199         if (strEQ(name, "FNDELAY"))
 200 #ifdef FNDELAY
 201             return FNDELAY;
 202 #else
 203             goto not_there;
 204 #endif
 205         if (strEQ(name, "FNONBLOCK"))
 206 #ifdef FNONBLOCK
 207             return FNONBLOCK;
 208 #else
 209             goto not_there;
 210 #endif
 211         if (strEQ(name, "FSYNC"))
 212 #ifdef FSYNC
 213             return FSYNC;
 214 #else
 215             goto not_there;
 216 #endif
 217         if (strEQ(name, "FTRUNC"))
 218 #ifdef FTRUNC
 219             return FTRUNC;
 220 #else
 221             goto not_there;
 222 #endif
 223         break;
 224     case 'L':
 225         if (strnEQ(name, "LOCK_", 5)) {
 226             /* We support flock() on systems which don't have it, so
 227                always supply the constants. */
 228             if (strEQ(name, "LOCK_SH"))
 229 #ifdef LOCK_SH
 230                 return LOCK_SH;
 231 #else
 232                 return 1;
 233 #endif
 234             if (strEQ(name, "LOCK_EX"))
 235 #ifdef LOCK_EX
 236                 return LOCK_EX;
 237 #else
 238                 return 2;
 239 #endif
 240             if (strEQ(name, "LOCK_NB"))
 241 #ifdef LOCK_NB
 242                 return LOCK_NB;
 243 #else
 244                 return 4;
 245 #endif
 246             if (strEQ(name, "LOCK_UN"))
 247 #ifdef LOCK_UN
 248                 return LOCK_UN;
 249 #else
 250                 return 8;
 251 #endif
 252         } else
 253           goto not_there;
 254         break;
 255     case 'O':
 256         if (strnEQ(name, "O_", 2)) {
 257             if (strEQ(name, "O_ACCMODE"))
 258 #ifdef O_ACCMODE
 259                 return O_ACCMODE;
 260 #else
 261                 goto not_there;
 262 #endif
 263             if (strEQ(name, "O_APPEND"))
 264 #ifdef O_APPEND
 265                 return O_APPEND;
 266 #else
 267                 goto not_there;
 268 #endif
 269             if (strEQ(name, "O_ASYNC"))
 270 #ifdef O_ASYNC
 271                 return O_ASYNC;
 272 #else
 273                 goto not_there;
 274 #endif
 275             if (strEQ(name, "O_BINARY"))
 276 #ifdef O_BINARY
 277                 return O_BINARY;
 278 #else
 279                 goto not_there;
 280 #endif
 281             if (strEQ(name, "O_CREAT"))
 282 #ifdef O_CREAT
 283                 return O_CREAT;
 284 #else
 285                 goto not_there;
 286 #endif
 287             if (strEQ(name, "O_DEFER"))
 288 #ifdef O_DEFER
 289                 return O_DEFER;
 290 #else
 291                 goto not_there;
 292 #endif
 293             if (strEQ(name, "O_DSYNC"))
 294 #ifdef O_DSYNC
 295                 return O_DSYNC;
 296 #else
 297                 goto not_there;
 298 #endif
 299             if (strEQ(name, "O_EXCL"))
 300 #ifdef O_EXCL
 301                 return O_EXCL;
 302 #else
 303                 goto not_there;
 304 #endif
 305             if (strEQ(name, "O_EXLOCK"))
 306 #ifdef O_EXLOCK
 307                 return O_EXLOCK;
 308 #else
 309                 goto not_there;
 310 #endif
 311             if (strEQ(name, "O_LARGEFILE"))
 312 #ifdef O_LARGEFILE
 313                 return O_LARGEFILE;
 314 #else
 315                 goto not_there;
 316 #endif
 317             if (strEQ(name, "O_NDELAY"))
 318 #ifdef O_NDELAY
 319                 return O_NDELAY;
 320 #else
 321                 goto not_there;
 322 #endif
 323             if (strEQ(name, "O_NOCTTY"))
 324 #ifdef O_NOCTTY
 325                 return O_NOCTTY;
 326 #else
 327                 goto not_there;
 328 #endif
 329             if (strEQ(name, "O_NONBLOCK"))
 330 #ifdef O_NONBLOCK
 331                 return O_NONBLOCK;
 332 #else
 333                 goto not_there;
 334 #endif
 335             if (strEQ(name, "O_RDONLY"))
 336 #ifdef O_RDONLY
 337                 return O_RDONLY;
 338 #else
 339                 goto not_there;
 340 #endif
 341             if (strEQ(name, "O_RDWR"))
 342 #ifdef O_RDWR
 343                 return O_RDWR;
 344 #else
 345                 goto not_there;
 346 #endif
 347             if (strEQ(name, "O_RSYNC"))
 348 #ifdef O_RSYNC
 349                 return O_RSYNC;
 350 #else
 351                 goto not_there;
 352 #endif
 353             if (strEQ(name, "O_SHLOCK"))
 354 #ifdef O_SHLOCK
 355                 return O_SHLOCK;
 356 #else
 357                 goto not_there;
 358 #endif
 359             if (strEQ(name, "O_SYNC"))
 360 #ifdef O_SYNC
 361                 return O_SYNC;
 362 #else
 363                 goto not_there;
 364 #endif
 365             if (strEQ(name, "O_TEXT"))
 366 #ifdef O_TEXT
 367                 return O_TEXT;
 368 #else
 369                 goto not_there;
 370 #endif
 371             if (strEQ(name, "O_TRUNC"))
 372 #ifdef O_TRUNC
 373                 return O_TRUNC;
 374 #else
 375                 goto not_there;
 376 #endif
 377             if (strEQ(name, "O_WRONLY"))
 378 #ifdef O_WRONLY
 379                 return O_WRONLY;
 380 #else
 381                 goto not_there;
 382 #endif
 383         } else
 384           goto not_there;
 385         break;
 386     }
 387     errno = EINVAL;
 388     return 0;
 389
 390 not_there:
 391     errno = ENOENT;
 392     return 0;
 393 }
 394
 395
 396 MODULE = Fcntl          PACKAGE = Fcntl
 397
 398 double
 399 constant(name,arg)
 400         char *          name
 401         int             arg
 402