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