[perl5.git] / ext / Fcntl / Fcntl.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#ifdef VMS
#  include <file.h>
#else
#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
#define _NO_OLDNAMES
#endif 
#  include <fcntl.h>
#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
#undef _NO_OLDNAMES
#endif 
#endif

/* This comment is a kludge to get metaconfig to see the symbols
    VAL_O_NONBLOCK
    VAL_EAGAIN
    RD_NODATA
    EOF_NONBLOCK
   and include the appropriate metaconfig unit
   so that Configure will test how to turn on non-blocking I/O
   for a file descriptor.  See config.h for how to use these
   in your extension. 
   
   While I'm at it, I'll have metaconfig look for HAS_POLL too.
   --AD  October 16, 1995
*/

static int
not_here(char *s)
{
    croak("%s not implemented on this architecture", s);
    return -1;
}

static double
constant(char *name, int arg)
{
    errno = 0;
    switch (*name) {
    case 'F':
	if (strnEQ(name, "F_", 2)) {
	    if (strEQ(name, "F_DUPFD"))
#ifdef F_DUPFD
	        return F_DUPFD;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_EXLCK"))
#ifdef F_EXLCK
	        return F_EXLCK;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_GETFD"))
#ifdef F_GETFD
	        return F_GETFD;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_GETFL"))
#ifdef F_GETFL
	        return F_GETFL;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_GETLK"))
#ifdef F_GETLK
	        return F_GETLK;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_GETLK64"))
#ifdef F_GETLK64
	        return F_GETLK64;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_GETOWN"))
#ifdef F_GETOWN
	        return F_GETOWN;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_POSIX"))
#ifdef F_POSIX
	        return F_POSIX;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_RDLCK"))
#ifdef F_RDLCK
	        return F_RDLCK;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_SETFD"))
#ifdef F_SETFD
	        return F_SETFD;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_SETFL"))
#ifdef F_SETFL
	        return F_SETFL;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_SETLK64"))
#ifdef F_SETLK64
	        return F_SETLK64;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_SETLKW"))
#ifdef F_SETLKW
	        return F_SETLKW;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_SETLKW64"))
#ifdef F_SETLKW64
	        return F_SETLKW64;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_SETOWN"))
#ifdef F_SETOWN
	        return F_SETOWN;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_SHLCK"))
#ifdef F_SHLCK
	        return F_SHLCK;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_UNLCK"))
#ifdef F_UNLCK
	        return F_UNLCK;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "F_WRLCK"))
#ifdef F_WRLCK
	        return F_WRLCK;
#else
	        goto not_there;
#endif
	    errno = EINVAL;
	    return 0;
	}
        if (strEQ(name, "FAPPEND"))
#ifdef FAPPEND
            return FAPPEND;
#else
            goto not_there;
#endif
        if (strEQ(name, "FASYNC"))
#ifdef FASYNC
            return FASYNC;
#else
            goto not_there;
#endif
        if (strEQ(name, "FCREAT"))
#ifdef FCREAT
            return FCREAT;
#else
            goto not_there;
#endif
	if (strEQ(name, "FD_CLOEXEC"))
#ifdef FD_CLOEXEC
	    return FD_CLOEXEC;
#else
	    goto not_there;
#endif
	if (strEQ(name, "FDEFER"))
#ifdef FDEFER
	    return FDEFER;
#else
	    goto not_there;
#endif
        if (strEQ(name, "FEXCL"))
#ifdef FEXCL
            return FEXCL;
#else
            goto not_there;
#endif
        if (strEQ(name, "FNDELAY"))
#ifdef FNDELAY
            return FNDELAY;
#else
            goto not_there;
#endif
        if (strEQ(name, "FNONBLOCK"))
#ifdef FNONBLOCK
            return FNONBLOCK;
#else
            goto not_there;
#endif
        if (strEQ(name, "FSYNC"))
#ifdef FSYNC
            return FSYNC;
#else
            goto not_there;
#endif
        if (strEQ(name, "FTRUNC"))
#ifdef FTRUNC
            return FTRUNC;
#else
            goto not_there;
#endif
	break;
    case 'L':
    	if (strnEQ(name, "LOCK_", 5)) {
	    /* We support flock() on systems which don't have it, so
	       always supply the constants. */
	    if (strEQ(name, "LOCK_SH"))
#ifdef LOCK_SH
		return LOCK_SH;
#else
		return 1;
#endif
	    if (strEQ(name, "LOCK_EX"))
#ifdef LOCK_EX
		return LOCK_EX;
#else
		return 2;
#endif
    	    if (strEQ(name, "LOCK_NB"))
#ifdef LOCK_NB
		return LOCK_NB;
#else
		return 4;
#endif
    	    if (strEQ(name, "LOCK_UN"))
#ifdef LOCK_UN
    	    	return LOCK_UN;
#else
    	    	return 8;
#endif
	} else
	  goto not_there;
    	break;
    case 'O':
	if (strnEQ(name, "O_", 2)) {
	    if (strEQ(name, "O_ACCMODE"))
#ifdef O_ACCMODE
	        return O_ACCMODE;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_APPEND"))
#ifdef O_APPEND
	        return O_APPEND;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_ASYNC"))
#ifdef O_ASYNC
	        return O_ASYNC;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_BINARY"))
#ifdef O_BINARY
	        return O_BINARY;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_CREAT"))
#ifdef O_CREAT
	        return O_CREAT;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_DEFER"))
#ifdef O_DEFER
	        return O_DEFER;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_DSYNC"))
#ifdef O_DSYNC
	        return O_DSYNC;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_EXCL"))
#ifdef O_EXCL
	        return O_EXCL;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_EXLOCK"))
#ifdef O_EXLOCK
	        return O_EXLOCK;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_LARGEFILE"))
#ifdef O_LARGEFILE
	        return O_LARGEFILE;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_NDELAY"))
#ifdef O_NDELAY
	        return O_NDELAY;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_NOCTTY"))
#ifdef O_NOCTTY
	        return O_NOCTTY;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_NONBLOCK"))
#ifdef O_NONBLOCK
	        return O_NONBLOCK;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_RDONLY"))
#ifdef O_RDONLY
	        return O_RDONLY;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_RDWR"))
#ifdef O_RDWR
	        return O_RDWR;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_RSYNC"))
#ifdef O_RSYNC
	        return O_RSYNC;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_SHLOCK"))
#ifdef O_SHLOCK
	        return O_SHLOCK;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_SYNC"))
#ifdef O_SYNC
	        return O_SYNC;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_TEXT"))
#ifdef O_TEXT
	        return O_TEXT;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_TRUNC"))
#ifdef O_TRUNC
	        return O_TRUNC;
#else
	        goto not_there;
#endif
	    if (strEQ(name, "O_WRONLY"))
#ifdef O_WRONLY
	        return O_WRONLY;
#else
	        goto not_there;
#endif
	} else
	  goto not_there;
	break;
    }
    errno = EINVAL;
    return 0;

not_there:
    errno = ENOENT;
    return 0;
}


MODULE = Fcntl		PACKAGE = Fcntl

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