home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / Fcntl / Fcntl.xs < prev    next >
Text File  |  2000-03-16  |  14KB  |  788 lines
  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, on name _S_IFMT return 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_NOINHERIT"))
  480. #ifdef O_NOINHERIT
  481.             return O_NOINHERIT;
  482. #else
  483.             goto not_there;
  484. #endif
  485.         if (strEQ(name, "O_NONBLOCK"))
  486. #ifdef O_NONBLOCK
  487.             return O_NONBLOCK;
  488. #else
  489.             goto not_there;
  490. #endif
  491.         if (strEQ(name, "O_RANDOM"))
  492. #ifdef O_RANDOM
  493.             return O_RANDOM;
  494. #else
  495.             goto not_there;
  496. #endif
  497.         if (strEQ(name, "O_RAW"))
  498. #ifdef O_RAW
  499.             return O_RAW;
  500. #else
  501.             goto not_there;
  502. #endif
  503.         if (strEQ(name, "O_RDONLY"))
  504. #ifdef O_RDONLY
  505.             return O_RDONLY;
  506. #else
  507.             goto not_there;
  508. #endif
  509.         if (strEQ(name, "O_RDWR"))
  510. #ifdef O_RDWR
  511.             return O_RDWR;
  512. #else
  513.             goto not_there;
  514. #endif
  515.         if (strEQ(name, "O_RSYNC"))
  516. #ifdef O_RSYNC
  517.             return O_RSYNC;
  518. #else
  519.             goto not_there;
  520. #endif
  521.         if (strEQ(name, "O_SEQUENTIAL"))
  522. #ifdef O_SEQUENTIAL
  523.             return O_SEQUENTIAL;
  524. #else
  525.             goto not_there;
  526. #endif
  527.         if (strEQ(name, "O_SHLOCK"))
  528. #ifdef O_SHLOCK
  529.             return O_SHLOCK;
  530. #else
  531.             goto not_there;
  532. #endif
  533.         if (strEQ(name, "O_SYNC"))
  534. #ifdef O_SYNC
  535.             return O_SYNC;
  536. #else
  537.             goto not_there;
  538. #endif
  539.         if (strEQ(name, "O_TEMPORARY"))
  540. #ifdef O_TEMPORARY
  541.             return O_TEMPORARY;
  542. #else
  543.             goto not_there;
  544. #endif
  545.         if (strEQ(name, "O_TEXT"))
  546. #ifdef O_TEXT
  547.             return O_TEXT;
  548. #else
  549.             goto not_there;
  550. #endif
  551.         if (strEQ(name, "O_TRUNC"))
  552. #ifdef O_TRUNC
  553.             return O_TRUNC;
  554. #else
  555.             goto not_there;
  556. #endif
  557.         if (strEQ(name, "O_WRONLY"))
  558. #ifdef O_WRONLY
  559.             return O_WRONLY;
  560. #else
  561.             goto not_there;
  562. #endif
  563.         if (strEQ(name, "O_ALIAS"))
  564. #ifdef O_ALIAS
  565.             return O_ALIAS;
  566. #else
  567.             goto not_there;
  568. #endif
  569.         if (strEQ(name, "O_RSRC"))
  570. #ifdef O_RSRC
  571.             return O_RSRC;
  572. #else
  573.             goto not_there;
  574. #endif
  575.     } else
  576.       goto not_there;
  577.     break;
  578.     case 'S':
  579.       switch (name[1]) {
  580.       case '_':
  581.     if (strEQ(name, "S_ISUID"))
  582. #ifdef S_ISUID
  583.       return S_ISUID;
  584. #else
  585.       goto not_there;
  586. #endif
  587.     if (strEQ(name, "S_ISGID"))
  588. #ifdef S_ISGID
  589.       return S_ISGID;
  590. #else
  591.       goto not_there;
  592. #endif
  593.     if (strEQ(name, "S_ISVTX"))
  594. #ifdef S_ISVTX
  595.       return S_ISVTX;
  596. #else
  597.       goto not_there;
  598. #endif
  599.     if (strEQ(name, "S_ISTXT"))
  600. #ifdef S_ISTXT
  601.       return S_ISTXT;
  602. #else
  603.       goto not_there;
  604. #endif
  605.     if (strEQ(name, "S_IFREG"))
  606. #ifdef S_IFREG
  607.       return S_IFREG;
  608. #else
  609.       goto not_there;
  610. #endif
  611.     if (strEQ(name, "S_IFDIR"))
  612. #ifdef S_IFDIR
  613.       return S_IFDIR;
  614. #else
  615.       goto not_there;
  616. #endif
  617.     if (strEQ(name, "S_IFLNK"))
  618. #ifdef S_IFLNK
  619.       return S_IFLNK;
  620. #else
  621.       goto not_there;
  622. #endif
  623.     if (strEQ(name, "S_IFSOCK"))
  624. #ifdef S_IFSOCK
  625.       return S_IFSOCK;
  626. #else
  627.       goto not_there;
  628. #endif
  629.     if (strEQ(name, "S_IFBLK"))
  630. #ifdef S_IFBLK
  631.       return S_IFBLK;
  632. #else
  633.       goto not_there;
  634. #endif
  635.     if (strEQ(name, "S_IFCHR"))
  636. #ifdef S_IFCHR
  637.       return S_IFCHR;
  638. #else
  639.       goto not_there;
  640. #endif
  641.     if (strEQ(name, "S_IFIFO"))
  642. #ifdef S_IFIFO
  643.       return S_IFIFO;
  644. #else
  645.       goto not_there;
  646. #endif
  647.     if (strEQ(name, "S_IFWHT"))
  648. #ifdef S_IFWHT
  649.       return S_IFWHT;
  650. #else
  651.       goto not_there;
  652. #endif
  653.     if (strEQ(name, "S_ENFMT"))
  654. #ifdef S_ENFMT
  655.       return S_ENFMT;
  656. #else
  657.       goto not_there;
  658. #endif
  659.     if (strEQ(name, "S_IRUSR"))
  660. #ifdef S_IRUSR
  661.       return S_IRUSR;
  662. #else
  663.       goto not_there;
  664. #endif
  665.     if (strEQ(name, "S_IWUSR"))
  666. #ifdef S_IWUSR
  667.       return S_IWUSR;
  668. #else
  669.       goto not_there;
  670. #endif
  671.     if (strEQ(name, "S_IXUSR"))
  672. #ifdef S_IXUSR
  673.       return S_IXUSR;
  674. #else
  675.       goto not_there;
  676. #endif
  677.     if (strEQ(name, "S_IRWXU"))
  678. #ifdef S_IRWXU
  679.       return S_IRWXU;
  680. #else
  681.       goto not_there;
  682. #endif
  683.     if (strEQ(name, "S_IRGRP"))
  684. #ifdef S_IRGRP
  685.       return S_IRGRP;
  686. #else
  687.       goto not_there;
  688. #endif
  689.     if (strEQ(name, "S_IWGRP"))
  690. #ifdef S_IWGRP
  691.       return S_IWGRP;
  692. #else
  693.       goto not_there;
  694. #endif
  695.     if (strEQ(name, "S_IXGRP"))
  696. #ifdef S_IXGRP
  697.       return S_IXGRP;
  698. #else
  699.       goto not_there;
  700. #endif
  701.     if (strEQ(name, "S_IRWXG"))
  702. #ifdef S_IRWXG
  703.       return S_IRWXG;
  704. #else
  705.       goto not_there;
  706. #endif
  707.     if (strEQ(name, "S_IROTH"))
  708. #ifdef S_IROTH
  709.       return S_IROTH;
  710. #else
  711.       goto not_there;
  712. #endif
  713.     if (strEQ(name, "S_IWOTH"))
  714. #ifdef S_IWOTH
  715.       return S_IWOTH;
  716. #else
  717.       goto not_there;
  718. #endif
  719.     if (strEQ(name, "S_IXOTH"))
  720. #ifdef S_IXOTH
  721.       return S_IXOTH;
  722. #else
  723.       goto not_there;
  724. #endif
  725.     if (strEQ(name, "S_IRWXO"))
  726. #ifdef S_IRWXO
  727.       return S_IRWXO;
  728. #else
  729.       goto not_there;
  730. #endif
  731.     if (strEQ(name, "S_IREAD"))
  732. #ifdef S_IREAD
  733.       return S_IREAD;
  734. #else
  735.       goto not_there;
  736. #endif
  737.     if (strEQ(name, "S_IWRITE"))
  738. #ifdef S_IWRITE
  739.       return S_IWRITE;
  740. #else
  741.       goto not_there;
  742. #endif
  743.     if (strEQ(name, "S_IEXEC"))
  744. #ifdef S_IEXEC
  745.       return S_IEXEC;
  746. #else
  747.       goto not_there;
  748. #endif
  749.     break;
  750.       case 'E':
  751.       if (strEQ(name, "SEEK_CUR"))
  752. #ifdef SEEK_CUR
  753.         return SEEK_CUR;
  754. #else
  755.         return 1;
  756. #endif
  757.     if (strEQ(name, "SEEK_END"))
  758. #ifdef SEEK_END
  759.         return SEEK_END;
  760. #else
  761.         return 2;
  762. #endif
  763.     if (strEQ(name, "SEEK_SET"))
  764. #ifdef SEEK_SET
  765.         return SEEK_SET;
  766. #else
  767.         return 0;
  768. #endif
  769.     break;
  770.       }    
  771.     }
  772.     errno = EINVAL;
  773.     return 0;
  774.  
  775. not_there:
  776.     errno = ENOENT;
  777.     return 0;
  778. }
  779.  
  780.  
  781. MODULE = Fcntl        PACKAGE = Fcntl
  782.  
  783. double
  784. constant(name,arg)
  785.     char *        name
  786.     int        arg
  787.  
  788.