perl5.git.perl.org Git - perl5.git/blame_incremental

... / ...

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