[p5sagit/p5-mst-13.2.git] / ext / GDBM_File / GDBM_File.xs

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

#include <gdbm.h>
#include <fcntl.h>

typedef GDBM_FILE GDBM_File;

#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
#define gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func) \
	gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)

#define gdbm_FETCH(db,key)			gdbm_fetch(db,key)
#define gdbm_STORE(db,key,value,flags)		gdbm_store(db,key,value,flags)
#define gdbm_DELETE(db,key)			gdbm_delete(db,key)
#define gdbm_FIRSTKEY(db)			gdbm_firstkey(db)
#define gdbm_NEXTKEY(db,key)			gdbm_nextkey(db,key)
#define gdbm_EXISTS(db,key)			gdbm_exists(db,key)

typedef void (*FATALFUNC)();

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

/* GDBM allocates the datum with system malloc() and expects the user
 * to free() it.  So we either have to free() it immediately, or have
 * perl free() it when it deallocates the SV, depending on whether
 * perl uses malloc()/free() or not. */
static void
output_datum(SV *arg, char *str, int size)
{
#if !defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))
	sv_usepvn(arg, str, size);
#else
	sv_setpvn(arg, str, size);
	safesysfree(str);
#endif
}

/* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
   gdbm_exists, and gdbm_setopt functions.  Apparently Slackware
   (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
*/
#ifndef GDBM_FAST
#define gdbm_exists(db,key) not_here("gdbm_exists")
#define gdbm_sync(db) (void) not_here("gdbm_sync")
#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
#endif

static double
constant(char *name, int arg)
{
    errno = 0;
    switch (*name) {
    case 'A':
	break;
    case 'B':
	break;
    case 'C':
	break;
    case 'D':
	break;
    case 'E':
	break;
    case 'F':
	break;
    case 'G':
	if (strEQ(name, "GDBM_CACHESIZE"))
#ifdef GDBM_CACHESIZE
	    return GDBM_CACHESIZE;
#else
	    goto not_there;
#endif
	if (strEQ(name, "GDBM_FAST"))
#ifdef GDBM_FAST
	    return GDBM_FAST;
#else
	    goto not_there;
#endif
	if (strEQ(name, "GDBM_FASTMODE"))
#ifdef GDBM_FASTMODE
	    return GDBM_FASTMODE;
#else
	    goto not_there;
#endif
	if (strEQ(name, "GDBM_INSERT"))
#ifdef GDBM_INSERT
	    return GDBM_INSERT;
#else
	    goto not_there;
#endif
	if (strEQ(name, "GDBM_NEWDB"))
#ifdef GDBM_NEWDB
	    return GDBM_NEWDB;
#else
	    goto not_there;
#endif
	if (strEQ(name, "GDBM_READER"))
#ifdef GDBM_READER
	    return GDBM_READER;
#else
	    goto not_there;
#endif
	if (strEQ(name, "GDBM_REPLACE"))
#ifdef GDBM_REPLACE
	    return GDBM_REPLACE;
#else
	    goto not_there;
#endif
	if (strEQ(name, "GDBM_WRCREAT"))
#ifdef GDBM_WRCREAT
	    return GDBM_WRCREAT;
#else
	    goto not_there;
#endif
	if (strEQ(name, "GDBM_WRITER"))
#ifdef GDBM_WRITER
	    return GDBM_WRITER;
#else
	    goto not_there;
#endif
	break;
    case 'H':
	break;
    case 'I':
	break;
    case 'J':
	break;
    case 'K':
	break;
    case 'L':
	break;
    case 'M':
	break;
    case 'N':
	break;
    case 'O':
	break;
    case 'P':
	break;
    case 'Q':
	break;
    case 'R':
	break;
    case 'S':
	break;
    case 'T':
	break;
    case 'U':
	break;
    case 'V':
	break;
    case 'W':
	break;
    case 'X':
	break;
    case 'Y':
	break;
    case 'Z':
	break;
    }
    errno = EINVAL;
    return 0;

not_there:
    errno = ENOENT;
    return 0;
}

MODULE = GDBM_File	PACKAGE = GDBM_File	PREFIX = gdbm_

double
constant(name,arg)
	char *		name
	int		arg


GDBM_File
gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
	char *		dbtype
	char *		name
	int		read_write
	int		mode
	FATALFUNC	fatal_func

void
gdbm_close(db)
	GDBM_File	db
	CLEANUP:

void
gdbm_DESTROY(db)
	GDBM_File	db
	CODE:
	gdbm_close(db);

datum
gdbm_FETCH(db, key)
	GDBM_File	db
	datum		key

int
gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
	GDBM_File	db
	datum		key
	datum		value
	int		flags
    CLEANUP:
	if (RETVAL) {
	    if (RETVAL < 0 && errno == EPERM)
		croak("No write permission to gdbm file");
	    croak("gdbm store returned %d, errno %d, key \"%.*s\"",
			RETVAL,errno,key.dsize,key.dptr);
	    /* gdbm_clearerr(db); */
	}

int
gdbm_DELETE(db, key)
	GDBM_File	db
	datum		key

datum
gdbm_FIRSTKEY(db)
	GDBM_File	db

datum
gdbm_NEXTKEY(db, key)
	GDBM_File	db
	datum		key

int
gdbm_reorganize(db)
	GDBM_File	db


void
gdbm_sync(db)
	GDBM_File	db

int
gdbm_EXISTS(db, key)
	GDBM_File	db
	datum		key

int
gdbm_setopt (db, optflag, optval, optlen)
	GDBM_File	db
	int		optflag
	int		&optval
	int		optlen
Commit	Line	Data
a0d0e21e	1	#include "EXTERN.h"
	2	#include "perl.h"
	3	#include "XSUB.h"
	4
	5	#include <gdbm.h>
	6	#include <fcntl.h>
	7
	8	typedef GDBM_FILE GDBM_File;
	9
	10	#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
	11	#define gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func) \
	12	gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)
	13
	14	#define gdbm_FETCH(db,key) gdbm_fetch(db,key)
	15	#define gdbm_STORE(db,key,value,flags) gdbm_store(db,key,value,flags)
	16	#define gdbm_DELETE(db,key) gdbm_delete(db,key)
	17	#define gdbm_FIRSTKEY(db) gdbm_firstkey(db)
	18	#define gdbm_NEXTKEY(db,key) gdbm_nextkey(db,key)
4633a7c4	19	#define gdbm_EXISTS(db,key) gdbm_exists(db,key)
a0d0e21e	20
12f917ad	21	typedef void (*FATALFUNC)();
a0d0e21e	22
a0d0e21e	23	static int
f0f333f4	24	not_here(char *s)
a0d0e21e	25	{
	26	croak("GDBM_File::%s not implemented on this architecture", s);
	27	return -1;
	28	}
	29
097d66a9	30	/* GDBM allocates the datum with system malloc() and expects the user
	31	* to free() it. So we either have to free() it immediately, or have
	32	* perl free() it when it deallocates the SV, depending on whether
	33	* perl uses malloc()/free() or not. */
	34	static void
	35	output_datum(SV arg, char str, int size)
	36	{
	37	#if !defined(MYMALLOC) \|\| (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))
	38	sv_usepvn(arg, str, size);
	39	#else
	40	sv_setpvn(arg, str, size);
	41	safesysfree(str);
	42	#endif
	43	}
	44
e50aee73	45	/* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
	46	gdbm_exists, and gdbm_setopt functions. Apparently Slackware
	47	(Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
	48	*/
	49	#ifndef GDBM_FAST
	50	#define gdbm_exists(db,key) not_here("gdbm_exists")
	51	#define gdbm_sync(db) (void) not_here("gdbm_sync")
	52	#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
	53	#endif
	54
a0d0e21e	55	static double
f0f333f4	56	constant(char *name, int arg)
a0d0e21e	57	{
	58	errno = 0;
	59	switch (*name) {
	60	case 'A':
	61	break;
	62	case 'B':
	63	break;
	64	case 'C':
	65	break;
	66	case 'D':
	67	break;
	68	case 'E':
	69	break;
	70	case 'F':
	71	break;
	72	case 'G':
	73	if (strEQ(name, "GDBM_CACHESIZE"))
	74	#ifdef GDBM_CACHESIZE
	75	return GDBM_CACHESIZE;
	76	#else
	77	goto not_there;
	78	#endif
	79	if (strEQ(name, "GDBM_FAST"))
	80	#ifdef GDBM_FAST
	81	return GDBM_FAST;
	82	#else
	83	goto not_there;
	84	#endif
	85	if (strEQ(name, "GDBM_FASTMODE"))
	86	#ifdef GDBM_FASTMODE
	87	return GDBM_FASTMODE;
	88	#else
	89	goto not_there;
	90	#endif
	91	if (strEQ(name, "GDBM_INSERT"))
	92	#ifdef GDBM_INSERT
	93	return GDBM_INSERT;
	94	#else
	95	goto not_there;
	96	#endif
	97	if (strEQ(name, "GDBM_NEWDB"))
	98	#ifdef GDBM_NEWDB
	99	return GDBM_NEWDB;
	100	#else
	101	goto not_there;
	102	#endif
	103	if (strEQ(name, "GDBM_READER"))
	104	#ifdef GDBM_READER
	105	return GDBM_READER;
	106	#else
	107	goto not_there;
	108	#endif
	109	if (strEQ(name, "GDBM_REPLACE"))
	110	#ifdef GDBM_REPLACE
	111	return GDBM_REPLACE;
	112	#else
	113	goto not_there;
	114	#endif
	115	if (strEQ(name, "GDBM_WRCREAT"))
	116	#ifdef GDBM_WRCREAT
	117	return GDBM_WRCREAT;
	118	#else
	119	goto not_there;
	120	#endif
121	if (strEQ(name, "GDBM_WRITER"))
122	#ifdef GDBM_WRITER
123	return GDBM_WRITER;
124	#else
125	goto not_there;
126	#endif
127	break;
128	case 'H':
129	break;
130	case 'I':
131	break;
132	case 'J':
133	break;
134	case 'K':
135	break;
136	case 'L':
137	break;
138	case 'M':
139	break;
140	case 'N':
141	break;
142	case 'O':
143	break;
144	case 'P':
145	break;
146	case 'Q':
147	break;
148	case 'R':
149	break;
150	case 'S':
151	break;
152	case 'T':
153	break;
154	case 'U':
155	break;
156	case 'V':
157	break;
158	case 'W':
159	break;
160	case 'X':
161	break;
162	case 'Y':
163	break;
164	case 'Z':
165	break;
166	}
167	errno = EINVAL;
168	return 0;
169
170	not_there:
171	errno = ENOENT;
172	return 0;
173	}
174
175	MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_
176
177	double
178	constant(name,arg)
179	char * name
180	int arg
181
182
183	GDBM_File
184	gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
185	char * dbtype
186	char * name
187	int read_write
188	int mode
189	FATALFUNC fatal_func
190
191	void
192	gdbm_close(db)
193	GDBM_File db
194	CLEANUP:
195
196	void
197	gdbm_DESTROY(db)
198	GDBM_File db
199	CODE:
200	gdbm_close(db);
201
097d66a9	202	datum
a0d0e21e	203	gdbm_FETCH(db, key)
	204	GDBM_File db
	205	datum key
	206
	207	int
	208	gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
	209	GDBM_File db
	210	datum key
	211	datum value
	212	int flags
	213	CLEANUP:
	214	if (RETVAL) {
	215	if (RETVAL < 0 && errno == EPERM)
	216	croak("No write permission to gdbm file");
748a9306	217	croak("gdbm store returned %d, errno %d, key \"%.*s\"",
a0d0e21e	218	RETVAL,errno,key.dsize,key.dptr);
	219	/* gdbm_clearerr(db); */
	220	}
	221
	222	int
	223	gdbm_DELETE(db, key)
	224	GDBM_File db
	225	datum key
	226
097d66a9	227	datum
a0d0e21e	228	gdbm_FIRSTKEY(db)
	229	GDBM_File db
	230
097d66a9	231	datum
a0d0e21e	232	gdbm_NEXTKEY(db, key)
	233	GDBM_File db
	234	datum key
	235
	236	int
	237	gdbm_reorganize(db)
	238	GDBM_File db
	239
3b35bae3	240
	241	void
	242	gdbm_sync(db)
	243	GDBM_File db
	244
	245	int
c07a80fd	246	gdbm_EXISTS(db, key)
3b35bae3	247	GDBM_File db
	248	datum key
	249
	250	int
	251	gdbm_setopt (db, optflag, optval, optlen)
	252	GDBM_File db
	253	int optflag
	254	int &optval
	255	int optlen
	256