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 #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 int
  37 not_here(char *s)
  38 {
  39     croak("%s not implemented on this architecture", s);
  40     return -1;
  41 }
  42
  43 static double
  44 constant(char *name, int arg)
  45 {
  46     errno = 0;
  47     switch (*name) {
  48     case '_':
  49         if (strEQ(name, "_S_IFMT")) /* Yes, _S_IFMT. */
  50 #ifdef S_IFMT
  51           return S_IFMT;
  52 #else
  53           goto not_there;
  54 #endif
  55         break;
  56     case 'F':
  57         if (strnEQ(name, "F_", 2)) {
  58             if (strEQ(name, "F_ALLOCSP"))
  59 #ifdef F_ALLOCSP
  60                 return F_ALLOCSP;
  61 #else
  62                 goto not_there;
  63 #endif
  64             if (strEQ(name, "F_ALLOCSP64"))
  65 #ifdef F_ALLOCSP64
  66                 return F_ALLOCSP64;
  67 #else
  68                 goto not_there;
  69 #endif
  70             if (strEQ(name, "F_COMPAT"))
  71 #ifdef F_COMPAT
  72                 return F_COMPAT;
  73 #else
  74                 goto not_there;
  75 #endif
  76             if (strEQ(name, "F_DUP2FD"))
  77 #ifdef F_DUP2FD
  78                 return F_DUP2FD;
  79 #else
  80                 goto not_there;
  81 #endif
  82             if (strEQ(name, "F_DUPFD"))
  83 #ifdef F_DUPFD
  84                 return F_DUPFD;
  85 #else
  86                 goto not_there;
  87 #endif
  88             if (strEQ(name, "F_EXLCK"))
  89 #ifdef F_EXLCK
  90                 return F_EXLCK;
  91 #else
  92                 goto not_there;
  93 #endif
  94             if (strEQ(name, "F_FREESP"))
  95 #ifdef F_FREESP
  96                 return F_FREESP;
  97 #else
  98                 goto not_there;
  99 #endif
 100             if (strEQ(name, "F_FREESP64"))
 101 #ifdef F_FREESP64
 102                 return F_FREESP64;
 103 #else
 104                 goto not_there;
 105 #endif
 106             if (strEQ(name, "F_FSYNC"))
 107 #ifdef F_FSYNC
 108                 return F_FSYNC;
 109 #else
 110                 goto not_there;
 111 #endif
 112             if (strEQ(name, "F_FSYNC64"))
 113 #ifdef F_FSYNC64
 114                 return F_FSYNC64;
 115 #else
 116                 goto not_there;
 117 #endif
 118             if (strEQ(name, "F_GETFD"))
 119 #ifdef F_GETFD
 120                 return F_GETFD;
 121 #else
 122                 goto not_there;
 123 #endif
 124             if (strEQ(name, "F_GETFL"))
 125 #ifdef F_GETFL
 126                 return F_GETFL;
 127 #else
 128                 goto not_there;
 129 #endif
 130             if (strEQ(name, "F_GETLK"))
 131 #ifdef F_GETLK
 132                 return F_GETLK;
 133 #else
 134                 goto not_there;
 135 #endif
 136             if (strEQ(name, "F_GETLK64"))
 137 #ifdef F_GETLK64
 138                 return F_GETLK64;
 139 #else
 140                 goto not_there;
 141 #endif
 142             if (strEQ(name, "F_GETOWN"))
 143 #ifdef F_GETOWN
 144                 return F_GETOWN;
 145 #else
 146                 goto not_there;
 147 #endif
 148             if (strEQ(name, "F_NODNY"))
 149 #ifdef F_NODNY
 150                 return F_NODNY;
 151 #else
 152                 goto not_there;
 153 #endif
 154             if (strEQ(name, "F_POSIX"))
 155 #ifdef F_POSIX
 156                 return F_POSIX;
 157 #else
 158                 goto not_there;
 159 #endif
 160             if (strEQ(name, "F_RDACC"))
 161 #ifdef F_RDACC
 162                 return F_RDACC;
 163 #else
 164                 goto not_there;
 165 #endif
 166             if (strEQ(name, "F_RDDNY"))
 167 #ifdef F_RDDNY
 168                 return F_RDDNY;
 169 #else
 170                 goto not_there;
 171 #endif
 172             if (strEQ(name, "F_RDLCK"))
 173 #ifdef F_RDLCK
 174                 return F_RDLCK;
 175 #else
 176                 goto not_there;
 177 #endif
 178             if (strEQ(name, "F_RWACC"))
 179 #ifdef F_RWACC
 180                 return F_RWACC;
 181 #else
 182                 goto not_there;
 183 #endif
 184             if (strEQ(name, "F_RWDNY"))
 185 #ifdef F_RWDNY
 186                 return F_RWDNY;
 187 #else
 188                 goto not_there;
 189 #endif
 190             if (strEQ(name, "F_SETFD"))
 191 #ifdef F_SETFD
 192                 return F_SETFD;
 193 #else
 194                 goto not_there;
 195 #endif
 196             if (strEQ(name, "F_SETFL"))
 197 #ifdef F_SETFL
 198                 return F_SETFL;
 199 #else
 200                 goto not_there;
 201 #endif
 202             if (strEQ(name, "F_SETLK"))
 203 #ifdef F_SETLK
 204                 return F_SETLK;
 205 #else
 206                 goto not_there;
 207 #endif
 208             if (strEQ(name, "F_SETLK64"))
 209 #ifdef F_SETLK64
 210                 return F_SETLK64;
 211 #else
 212                 goto not_there;
 213 #endif
 214             if (strEQ(name, "F_SETLKW"))
 215 #ifdef F_SETLKW
 216                 return F_SETLKW;
 217 #else
 218                 goto not_there;
 219 #endif
 220             if (strEQ(name, "F_SETLKW64"))
 221 #ifdef F_SETLKW64
 222                 return F_SETLKW64;
 223 #else
 224                 goto not_there;
 225 #endif
 226             if (strEQ(name, "F_SETOWN"))
 227 #ifdef F_SETOWN
 228                 return F_SETOWN;
 229 #else
 230                 goto not_there;
 231 #endif
 232             if (strEQ(name, "F_SHARE"))
 233 #ifdef F_SHARE
 234                 return F_SHARE;
 235 #else
 236                 goto not_there;
 237 #endif
 238             if (strEQ(name, "F_SHLCK"))
 239 #ifdef F_SHLCK
 240                 return F_SHLCK;
 241 #else
 242                 goto not_there;
 243 #endif
 244             if (strEQ(name, "F_UNLCK"))
 245 #ifdef F_UNLCK
 246                 return F_UNLCK;
 247 #else
 248                 goto not_there;
 249 #endif
 250             if (strEQ(name, "F_UNSHARE"))
 251 #ifdef F_UNSHARE
 252                 return F_UNSHARE;
 253 #else
 254                 goto not_there;
 255 #endif
 256             if (strEQ(name, "F_WRACC"))
 257 #ifdef F_WRACC
 258                 return F_WRACC;
 259 #else
 260                 goto not_there;
 261 #endif
 262             if (strEQ(name, "F_WRDNY"))
 263 #ifdef F_WRDNY
 264                 return F_WRDNY;
 265 #else
 266                 goto not_there;
 267 #endif
 268             if (strEQ(name, "F_WRLCK"))
 269 #ifdef F_WRLCK
 270                 return F_WRLCK;
 271 #else
 272                 goto not_there;
 273 #endif
 274             errno = EINVAL;
 275             return 0;
 276         }
 277         if (strEQ(name, "FAPPEND"))
 278 #ifdef FAPPEND
 279             return FAPPEND;
 280 #else
 281             goto not_there;
 282 #endif
 283         if (strEQ(name, "FASYNC"))
 284 #ifdef FASYNC
 285             return FASYNC;
 286 #else
 287             goto not_there;
 288 #endif
 289         if (strEQ(name, "FCREAT"))
 290 #ifdef FCREAT
 291             return FCREAT;
 292 #else
 293             goto not_there;
 294 #endif
 295         if (strEQ(name, "FD_CLOEXEC"))
 296 #ifdef FD_CLOEXEC
 297             return FD_CLOEXEC;
 298 #else
 299             goto not_there;
 300 #endif
 301         if (strEQ(name, "FDEFER"))
 302 #ifdef FDEFER
 303             return FDEFER;
 304 #else
 305             goto not_there;
 306 #endif
 307         if (strEQ(name, "FDSYNC"))
 308 #ifdef FDSYNC
 309             return FDSYNC;
 310 #else
 311             goto not_there;
 312 #endif
 313         if (strEQ(name, "FEXCL"))
 314 #ifdef FEXCL
 315             return FEXCL;
 316 #else
 317             goto not_there;
 318 #endif
 319         if (strEQ(name, "FLARGEFILE"))
 320 #ifdef FLARGEFILE
 321             return FLARGEFILE;
 322 #else
 323             goto not_there;
 324 #endif
 325         if (strEQ(name, "FNDELAY"))
 326 #ifdef FNDELAY
 327             return FNDELAY;
 328 #else
 329             goto not_there;
 330 #endif
 331         if (strEQ(name, "FNONBLOCK"))
 332 #ifdef FNONBLOCK
 333             return FNONBLOCK;
 334 #else
 335             goto not_there;
 336 #endif
 337         if (strEQ(name, "FRSYNC"))
 338 #ifdef FRSYNC
 339             return FRSYNC;
 340 #else
 341             goto not_there;
 342 #endif
 343         if (strEQ(name, "FSYNC"))
 344 #ifdef FSYNC
 345             return FSYNC;
 346 #else
 347             goto not_there;
 348 #endif
 349         if (strEQ(name, "FTRUNC"))
 350 #ifdef FTRUNC
 351             return FTRUNC;
 352 #else
 353             goto not_there;
 354 #endif
 355         break;
 356     case 'L':
 357         if (strnEQ(name, "LOCK_", 5)) {
 358             /* We support flock() on systems which don't have it, so
 359                always supply the constants. */
 360             if (strEQ(name, "LOCK_SH"))
 361 #ifdef LOCK_SH
 362                 return LOCK_SH;
 363 #else
 364                 return 1;
 365 #endif
 366             if (strEQ(name, "LOCK_EX"))
 367 #ifdef LOCK_EX
 368                 return LOCK_EX;
 369 #else
 370                 return 2;
 371 #endif
 372             if (strEQ(name, "LOCK_NB"))
 373 #ifdef LOCK_NB
 374                 return LOCK_NB;
 375 #else
 376                 return 4;
 377 #endif
 378             if (strEQ(name, "LOCK_UN"))
 379 #ifdef LOCK_UN
 380                 return LOCK_UN;
 381 #else
 382                 return 8;
 383 #endif
 384         } else
 385           goto not_there;
 386         break;
 387     case 'O':
 388         if (strnEQ(name, "O_", 2)) {
 389             if (strEQ(name, "O_ACCMODE"))
 390 #ifdef O_ACCMODE
 391                 return O_ACCMODE;
 392 #else
 393                 goto not_there;
 394 #endif
 395             if (strEQ(name, "O_APPEND"))
 396 #ifdef O_APPEND
 397                 return O_APPEND;
 398 #else
 399                 goto not_there;
 400 #endif
 401             if (strEQ(name, "O_ASYNC"))
 402 #ifdef O_ASYNC
 403                 return O_ASYNC;
 404 #else
 405                 goto not_there;
 406 #endif
 407             if (strEQ(name, "O_BINARY"))
 408 #ifdef O_BINARY
 409                 return O_BINARY;
 410 #else
 411                 goto not_there;
 412 #endif
 413             if (strEQ(name, "O_CREAT"))
 414 #ifdef O_CREAT
 415                 return O_CREAT;
 416 #else
 417                 goto not_there;
 418 #endif
 419             if (strEQ(name, "O_DEFER"))
 420 #ifdef O_DEFER
 421                 return O_DEFER;
 422 #else
 423                 goto not_there;
 424 #endif
 425             if (strEQ(name, "O_DIRECT"))
 426 #ifdef O_DIRECT
 427                 return O_DIRECT;
 428 #else
 429                 goto not_there;
 430 #endif
 431             if (strEQ(name, "O_DIRECTORY"))
 432 #ifdef O_DIRECTORY
 433                 return O_DIRECTORY;
 434 #else
 435                 goto not_there;
 436 #endif
 437             if (strEQ(name, "O_DSYNC"))
 438 #ifdef O_DSYNC
 439                 return O_DSYNC;
 440 #else
 441                 goto not_there;
 442 #endif
 443             if (strEQ(name, "O_EXCL"))
 444 #ifdef O_EXCL
 445                 return O_EXCL;
 446 #else
 447                 goto not_there;
 448 #endif
 449             if (strEQ(name, "O_EXLOCK"))
 450 #ifdef O_EXLOCK
 451                 return O_EXLOCK;
 452 #else
 453                 goto not_there;
 454 #endif
 455             if (strEQ(name, "O_LARGEFILE"))
 456 #ifdef O_LARGEFILE
 457                 return O_LARGEFILE;
 458 #else
 459                 goto not_there;
 460 #endif
 461             if (strEQ(name, "O_NDELAY"))
 462 #ifdef O_NDELAY
 463                 return O_NDELAY;
 464 #else
 465                 goto not_there;
 466 #endif
 467             if (strEQ(name, "O_NOCTTY"))
 468 #ifdef O_NOCTTY
 469                 return O_NOCTTY;
 470 #else
 471                 goto not_there;
 472 #endif
 473             if (strEQ(name, "O_NOFOLLOW"))
 474 #ifdef O_NOFOLLOW
 475                 return O_NOFOLLOW;
 476 #else
 477                 goto not_there;
 478 #endif
 479             if (strEQ(name, "O_NONBLOCK"))
 480 #ifdef O_NONBLOCK
 481                 return O_NONBLOCK;
 482 #else
 483                 goto not_there;
 484 #endif
 485             if (strEQ(name, "O_RDONLY"))
 486 #ifdef O_RDONLY
 487                 return O_RDONLY;
 488 #else
 489                 goto not_there;
 490 #endif
 491             if (strEQ(name, "O_RDWR"))
 492 #ifdef O_RDWR
 493                 return O_RDWR;
 494 #else
 495                 goto not_there;
 496 #endif
 497             if (strEQ(name, "O_RSYNC"))
 498 #ifdef O_RSYNC
 499                 return O_RSYNC;
 500 #else
 501                 goto not_there;
 502 #endif
 503             if (strEQ(name, "O_SHLOCK"))
 504 #ifdef O_SHLOCK
 505                 return O_SHLOCK;
 506 #else
 507                 goto not_there;
 508 #endif
 509             if (strEQ(name, "O_SYNC"))
 510 #ifdef O_SYNC
 511                 return O_SYNC;
 512 #else
 513                 goto not_there;
 514 #endif
 515             if (strEQ(name, "O_TEMPORARY"))
 516 #ifdef O_TEMPORARY
 517                 return O_TEMPORARY;
 518 #else
 519                 goto not_there;
 520 #endif
 521             if (strEQ(name, "O_TEXT"))
 522 #ifdef O_TEXT
 523                 return O_TEXT;
 524 #else
 525                 goto not_there;
 526 #endif
 527             if (strEQ(name, "O_TRUNC"))
 528 #ifdef O_TRUNC
 529                 return O_TRUNC;
 530 #else
 531                 goto not_there;
 532 #endif
 533             if (strEQ(name, "O_WRONLY"))
 534 #ifdef O_WRONLY
 535                 return O_WRONLY;
 536 #else
 537                 goto not_there;
 538 #endif
 539             if (strEQ(name, "O_ALIAS"))
 540 #ifdef O_ALIAS
 541                 return O_ALIAS;
 542 #else
 543                 goto not_there;
 544 #endif
 545             if (strEQ(name, "O_RSRC"))
 546 #ifdef O_RSRC
 547                 return O_RSRC;
 548 #else
 549                 goto not_there;
 550 #endif
 551         } else
 552           goto not_there;
 553         break;
 554     case 'S':
 555       switch (name[1]) {
 556       case '_':
 557         if (strEQ(name, "S_ISUID"))
 558 #ifdef S_ISUID
 559           return S_ISUID;
 560 #else
 561           goto not_there;
 562 #endif
 563         if (strEQ(name, "S_ISGID"))
 564 #ifdef S_ISGID
 565           return S_ISGID;
 566 #else
 567           goto not_there;
 568 #endif
 569         if (strEQ(name, "S_ISVTX"))
 570 #ifdef S_ISVTX
 571           return S_ISVTX;
 572 #else
 573           goto not_there;
 574 #endif
 575         if (strEQ(name, "S_ISTXT"))
 576 #ifdef S_ISTXT
 577           return S_ISTXT;
 578 #else
 579           goto not_there;
 580 #endif
 581         if (strEQ(name, "S_IFREG"))
 582 #ifdef S_IFREG
 583           return S_IFREG;
 584 #else
 585           goto not_there;
 586 #endif
 587         if (strEQ(name, "S_IFDIR"))
 588 #ifdef S_IFDIR
 589           return S_IFDIR;
 590 #else
 591           goto not_there;
 592 #endif
 593         if (strEQ(name, "S_IFLNK"))
 594 #ifdef S_IFLNK
 595           return S_IFLNK;
 596 #else
 597           goto not_there;
 598 #endif
 599         if (strEQ(name, "S_IFSOCK"))
 600 #ifdef S_IFSOCK
 601           return S_IFSOCK;
 602 #else
 603           goto not_there;
 604 #endif
 605         if (strEQ(name, "S_IFBLK"))
 606 #ifdef S_IFBLK
 607           return S_IFBLK;
 608 #else
 609           goto not_there;
 610 #endif
 611         if (strEQ(name, "S_IFCHR"))
 612 #ifdef S_IFCHR
 613           return S_IFCHR;
 614 #else
 615           goto not_there;
 616 #endif
 617         if (strEQ(name, "S_IFIFO"))
 618 #ifdef S_IFIFO
 619           return S_IFIFO;
 620 #else
 621           goto not_there;
 622 #endif
 623         if (strEQ(name, "S_IFWHT"))
 624 #ifdef S_IFWHT
 625           return S_IFWHT;
 626 #else
 627           goto not_there;
 628 #endif
 629         if (strEQ(name, "S_ENFMT"))
 630 #ifdef S_ENFMT
 631           return S_ENFMT;
 632 #else
 633           goto not_there;
 634 #endif
 635         if (strEQ(name, "S_IRUSR"))
 636 #ifdef S_IRUSR
 637           return S_IRUSR;
 638 #else
 639           goto not_there;
 640 #endif
 641         if (strEQ(name, "S_IWUSR"))
 642 #ifdef S_IWUSR
 643           return S_IWUSR;
 644 #else
 645           goto not_there;
 646 #endif
 647         if (strEQ(name, "S_IXUSR"))
 648 #ifdef S_IXUSR
 649           return S_IXUSR;
 650 #else
 651           goto not_there;
 652 #endif
 653         if (strEQ(name, "S_IRWXU"))
 654 #ifdef S_IRWXU
 655           return S_IRWXU;
 656 #else
 657           goto not_there;
 658 #endif
 659         if (strEQ(name, "S_IRGRP"))
 660 #ifdef S_IRGRP
 661           return S_IRGRP;
 662 #else
 663           goto not_there;
 664 #endif
 665         if (strEQ(name, "S_IWGRP"))
 666 #ifdef S_IWGRP
 667           return S_IWGRP;
 668 #else
 669           goto not_there;
 670 #endif
 671         if (strEQ(name, "S_IXGRP"))
 672 #ifdef S_IXGRP
 673           return S_IXGRP;
 674 #else
 675           goto not_there;
 676 #endif
 677         if (strEQ(name, "S_IRWXG"))
 678 #ifdef S_IRWXG
 679           return S_IRWXG;
 680 #else
 681           goto not_there;
 682 #endif
 683         if (strEQ(name, "S_IROTH"))
 684 #ifdef S_IROTH
 685           return S_IROTH;
 686 #else
 687           goto not_there;
 688 #endif
 689         if (strEQ(name, "S_IWOTH"))
 690 #ifdef S_IWOTH
 691           return S_IWOTH;
 692 #else
 693           goto not_there;
 694 #endif
 695         if (strEQ(name, "S_IXOTH"))
 696 #ifdef S_IXOTH
 697           return S_IXOTH;
 698 #else
 699           goto not_there;
 700 #endif
 701         if (strEQ(name, "S_IRWXO"))
 702 #ifdef S_IRWXO
 703           return S_IRWXO;
 704 #else
 705           goto not_there;
 706 #endif
 707         if (strEQ(name, "S_IREAD"))
 708 #ifdef S_IREAD
 709           return S_IREAD;
 710 #else
 711           goto not_there;
 712 #endif
 713         if (strEQ(name, "S_IWRITE"))
 714 #ifdef S_IWRITE
 715           return S_IWRITE;
 716 #else
 717           goto not_there;
 718 #endif
 719         if (strEQ(name, "S_IEXEC"))
 720 #ifdef S_IEXEC
 721           return S_IEXEC;
 722 #else
 723           goto not_there;
 724 #endif
 725         break;
 726       case 'E':
 727           if (strEQ(name, "SEEK_CUR"))
 728 #ifdef SEEK_CUR
 729             return SEEK_CUR;
 730 #else
 731             return 1;
 732 #endif
 733         if (strEQ(name, "SEEK_END"))
 734 #ifdef SEEK_END
 735             return SEEK_END;
 736 #else
 737             return 2;
 738 #endif
 739         if (strEQ(name, "SEEK_SET"))
 740 #ifdef SEEK_SET
 741             return SEEK_SET;
 742 #else
 743             return 0;
 744 #endif
 745         break;
 746       }
 747     }
 748     errno = EINVAL;
 749     return 0;
 750
 751 not_there:
 752     errno = ENOENT;
 753     return 0;
 754 }
 755
 756
 757 MODULE = Fcntl          PACKAGE = Fcntl
 758
 759 double
 760 constant(name,arg)
 761         char *          name
 762         int             arg
 763