[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 struct {
	GDBM_FILE 	dbp ;
	SV *    filter_fetch_key ;
	SV *    filter_store_key ;
	SV *    filter_fetch_value ;
	SV *    filter_store_value ;
	int     filtering ;
	} GDBM_File_type;

typedef GDBM_File_type * GDBM_File ;
typedef datum datum_key ;
typedef datum datum_value ;

#define ckFilter(arg,type,name)					\
	if (db->type) {						\
	    SV * save_defsv ;					\
            /* printf("filtering %s\n", name) ;*/		\
	    if (db->filtering)					\
	        croak("recursion detected in %s", name) ;	\
	    db->filtering = TRUE ;				\
	    save_defsv = newSVsv(DEFSV) ;			\
	    sv_setsv(DEFSV, arg) ;				\
	    PUSHMARK(sp) ;					\
	    (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); 	\
	    sv_setsv(arg, DEFSV) ;				\
	    sv_setsv(DEFSV, save_defsv) ;			\
	    SvREFCNT_dec(save_defsv) ;				\
	    db->filtering = FALSE ;				\
	    /*printf("end of filtering %s\n", name) ;*/		\
	}


#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */

typedef void (*FATALFUNC)();

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

/* 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(pTHX_ SV *arg, char *str, int size)
{
#if (!defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))) && !defined(LEAKTEST)
	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
	CODE:
	{
	    GDBM_FILE  	dbp ;

	    RETVAL = NULL ;
	    if ((dbp =  gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) {
	        RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
    	        Zero(RETVAL, 1, GDBM_File_type) ;
		RETVAL->dbp = dbp ;
	    }
	    
	}
	OUTPUT:
	  RETVAL
	

#define gdbm_close(db)			gdbm_close(db->dbp)
void
gdbm_close(db)
	GDBM_File	db
	CLEANUP:

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

#define gdbm_FETCH(db,key)			gdbm_fetch(db->dbp,key)
datum_value
gdbm_FETCH(db, key)
	GDBM_File	db
	datum_key	key

#define gdbm_STORE(db,key,value,flags)		gdbm_store(db->dbp,key,value,flags)
int
gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
	GDBM_File	db
	datum_key	key
	datum_value	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);
	}

#define gdbm_DELETE(db,key)			gdbm_delete(db->dbp,key)
int
gdbm_DELETE(db, key)
	GDBM_File	db
	datum_key	key

#define gdbm_FIRSTKEY(db)			gdbm_firstkey(db->dbp)
datum_key
gdbm_FIRSTKEY(db)
	GDBM_File	db

#define gdbm_NEXTKEY(db,key)			gdbm_nextkey(db->dbp,key)
datum_key
gdbm_NEXTKEY(db, key)
	GDBM_File	db
	datum_key	key

#define gdbm_reorganize(db)			gdbm_reorganize(db->dbp)
int
gdbm_reorganize(db)
	GDBM_File	db


#define gdbm_sync(db)				gdbm_sync(db->dbp)
void
gdbm_sync(db)
	GDBM_File	db

#define gdbm_EXISTS(db,key)			gdbm_exists(db->dbp,key)
int
gdbm_EXISTS(db, key)
	GDBM_File	db
	datum_key	key

#define gdbm_setopt(db,optflag, optval, optlen)	gdbm_setopt(db->dbp,optflag, optval, optlen)
int
gdbm_setopt (db, optflag, optval, optlen)
	GDBM_File	db
	int		optflag
	int		&optval
	int		optlen


#define setFilter(type)					\
	{						\
	    if (db->type)				\
	        RETVAL = sv_mortalcopy(db->type) ; 	\
	    ST(0) = RETVAL ;				\
	    if (db->type && (code == &PL_sv_undef)) {	\
                SvREFCNT_dec(db->type) ;		\
	        db->type = NULL ;			\
	    }						\
	    else if (code) {				\
	        if (db->type)				\
	            sv_setsv(db->type, code) ;		\
	        else					\
	            db->type = newSVsv(code) ;		\
	    }	    					\
	}


SV *
filter_fetch_key(db, code)
	GDBM_File	db
	SV *		code
	SV *		RETVAL = &PL_sv_undef ;
	CODE:
	    setFilter(filter_fetch_key) ;

SV *
filter_store_key(db, code)
	GDBM_File	db
	SV *		code
	SV *		RETVAL =  &PL_sv_undef ;
	CODE:
	    setFilter(filter_store_key) ;

SV *
filter_fetch_value(db, code)
	GDBM_File	db
	SV *		code
	SV *		RETVAL =  &PL_sv_undef ;
	CODE:
	    setFilter(filter_fetch_value) ;

SV *
filter_store_value(db, code)
	GDBM_File	db
	SV *		code
	SV *		RETVAL =  &PL_sv_undef ;
	CODE:
	    setFilter(filter_store_value) ;
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
9fe6733a	8	typedef struct {
	9	GDBM_FILE dbp ;
	10	SV * filter_fetch_key ;
	11	SV * filter_store_key ;
	12	SV * filter_fetch_value ;
	13	SV * filter_store_value ;
	14	int filtering ;
	15	} GDBM_File_type;
	16
	17	typedef GDBM_File_type * GDBM_File ;
	18	typedef datum datum_key ;
	19	typedef datum datum_value ;
	20
	21	#define ckFilter(arg,type,name) \
	22	if (db->type) { \
	23	SV * save_defsv ; \
	24	/* printf("filtering %s\n", name) ;*/ \
	25	if (db->filtering) \
	26	croak("recursion detected in %s", name) ; \
	27	db->filtering = TRUE ; \
	28	save_defsv = newSVsv(DEFSV) ; \
	29	sv_setsv(DEFSV, arg) ; \
	30	PUSHMARK(sp) ; \
	31	(void) perl_call_sv(db->type, G_DISCARD\|G_NOARGS); \
	32	sv_setsv(arg, DEFSV) ; \
	33	sv_setsv(DEFSV, save_defsv) ; \
	34	SvREFCNT_dec(save_defsv) ; \
	35	db->filtering = FALSE ; \
	36	/printf("end of filtering %s\n", name) ;/ \
	37	}
a0d0e21e	38
a0d0e21e	39
9fe6733a	40
9fe6733a	41	#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
a0d0e21e	42
12f917ad	43	typedef void (*FATALFUNC)();
a0d0e21e	44
8063af02	45	#ifndef GDBM_FAST
a0d0e21e	46	static int
f0f333f4	47	not_here(char *s)
a0d0e21e	48	{
	49	croak("GDBM_File::%s not implemented on this architecture", s);
	50	return -1;
	51	}
8063af02	52	#endif
a0d0e21e	53
097d66a9	54	/* GDBM allocates the datum with system malloc() and expects the user
	55	* to free() it. So we either have to free() it immediately, or have
	56	* perl free() it when it deallocates the SV, depending on whether
	57	* perl uses malloc()/free() or not. */
	58	static void
caa0600b	59	output_datum(pTHX_ SV arg, char str, int size)
097d66a9	60	{
53e3a7fb	61	#if (!defined(MYMALLOC) \|\| (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))) && !defined(LEAKTEST)
097d66a9	62	sv_usepvn(arg, str, size);
	63	#else
	64	sv_setpvn(arg, str, size);
	65	safesysfree(str);
	66	#endif
	67	}
	68
e50aee73	69	/* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
	70	gdbm_exists, and gdbm_setopt functions. Apparently Slackware
	71	(Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
	72	*/
	73	#ifndef GDBM_FAST
	74	#define gdbm_exists(db,key) not_here("gdbm_exists")
	75	#define gdbm_sync(db) (void) not_here("gdbm_sync")
	76	#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
	77	#endif
	78
a0d0e21e	79	static double
f0f333f4	80	constant(char *name, int arg)
a0d0e21e	81	{
	82	errno = 0;
	83	switch (*name) {
	84	case 'A':
	85	break;
	86	case 'B':
	87	break;
	88	case 'C':
	89	break;
	90	case 'D':
	91	break;
	92	case 'E':
	93	break;
	94	case 'F':
	95	break;
	96	case 'G':
	97	if (strEQ(name, "GDBM_CACHESIZE"))
	98	#ifdef GDBM_CACHESIZE
	99	return GDBM_CACHESIZE;
	100	#else
	101	goto not_there;
	102	#endif
	103	if (strEQ(name, "GDBM_FAST"))
	104	#ifdef GDBM_FAST
	105	return GDBM_FAST;
	106	#else
	107	goto not_there;
	108	#endif
	109	if (strEQ(name, "GDBM_FASTMODE"))
	110	#ifdef GDBM_FASTMODE
	111	return GDBM_FASTMODE;
	112	#else
	113	goto not_there;
	114	#endif
	115	if (strEQ(name, "GDBM_INSERT"))
	116	#ifdef GDBM_INSERT
	117	return GDBM_INSERT;
	118	#else
	119	goto not_there;
	120	#endif
	121	if (strEQ(name, "GDBM_NEWDB"))
	122	#ifdef GDBM_NEWDB
	123	return GDBM_NEWDB;
	124	#else
	125	goto not_there;
	126	#endif
	127	if (strEQ(name, "GDBM_READER"))
	128	#ifdef GDBM_READER
	129	return GDBM_READER;
	130	#else
	131	goto not_there;
	132	#endif
	133	if (strEQ(name, "GDBM_REPLACE"))
	134	#ifdef GDBM_REPLACE
	135	return GDBM_REPLACE;
	136	#else
	137	goto not_there;
	138	#endif
	139	if (strEQ(name, "GDBM_WRCREAT"))
	140	#ifdef GDBM_WRCREAT
	141	return GDBM_WRCREAT;
	142	#else
	143	goto not_there;
	144	#endif
145	if (strEQ(name, "GDBM_WRITER"))
146	#ifdef GDBM_WRITER
147	return GDBM_WRITER;
148	#else
149	goto not_there;
150	#endif
151	break;
152	case 'H':
153	break;
154	case 'I':
155	break;
156	case 'J':
157	break;
158	case 'K':
159	break;
160	case 'L':
161	break;
162	case 'M':
163	break;
164	case 'N':
165	break;
166	case 'O':
167	break;
168	case 'P':
169	break;
170	case 'Q':
171	break;
172	case 'R':
173	break;
174	case 'S':
175	break;
176	case 'T':
177	break;
178	case 'U':
179	break;
180	case 'V':
181	break;
182	case 'W':
183	break;
184	case 'X':
185	break;
186	case 'Y':
187	break;
188	case 'Z':
189	break;
190	}
191	errno = EINVAL;
192	return 0;
193
194	not_there:
195	errno = ENOENT;
196	return 0;
197	}
198
199	MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_
200
201	double
202	constant(name,arg)
203	char * name
204	int arg
205
206
207	GDBM_File
208	gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
209	char * dbtype
210	char * name
211	int read_write
212	int mode
213	FATALFUNC fatal_func
9fe6733a	214	CODE:
	215	{
	216	GDBM_FILE dbp ;
a0d0e21e	217
9fe6733a	218	RETVAL = NULL ;
8063af02	219	if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) {
9fe6733a	220	RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
	221	Zero(RETVAL, 1, GDBM_File_type) ;
	222	RETVAL->dbp = dbp ;
	223	}
	224
	225	}
	226	OUTPUT:
	227	RETVAL
	228
	229
	230	#define gdbm_close(db) gdbm_close(db->dbp)
a0d0e21e	231	void
	232	gdbm_close(db)
	233	GDBM_File db
	234	CLEANUP:
	235
	236	void
	237	gdbm_DESTROY(db)
	238	GDBM_File db
	239	CODE:
	240	gdbm_close(db);
eb99164f	241	safefree(db);
a0d0e21e	242
9fe6733a	243	#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
9fe6733a	244	datum_value
a0d0e21e	245	gdbm_FETCH(db, key)
a0d0e21e	246	GDBM_File db
9fe6733a	247	datum_key key
a0d0e21e	248
9fe6733a	249	#define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags)
a0d0e21e	250	int
	251	gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
	252	GDBM_File db
9fe6733a	253	datum_key key
9fe6733a	254	datum_value value
a0d0e21e	255	int flags
	256	CLEANUP:
	257	if (RETVAL) {
	258	if (RETVAL < 0 && errno == EPERM)
	259	croak("No write permission to gdbm file");
748a9306	260	croak("gdbm store returned %d, errno %d, key \"%.*s\"",
a0d0e21e	261	RETVAL,errno,key.dsize,key.dptr);
a0d0e21e	262	}
a0d0e21e	263
9fe6733a	264	#define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key)
a0d0e21e	265	int
	266	gdbm_DELETE(db, key)
	267	GDBM_File db
9fe6733a	268	datum_key key
a0d0e21e	269
9fe6733a	270	#define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp)
9fe6733a	271	datum_key
a0d0e21e	272	gdbm_FIRSTKEY(db)
	273	GDBM_File db
	274
9fe6733a	275	#define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key)
9fe6733a	276	datum_key
a0d0e21e	277	gdbm_NEXTKEY(db, key)
a0d0e21e	278	GDBM_File db
9fe6733a	279	datum_key key
a0d0e21e	280
9fe6733a	281	#define gdbm_reorganize(db) gdbm_reorganize(db->dbp)
a0d0e21e	282	int
	283	gdbm_reorganize(db)
	284	GDBM_File db
	285
3b35bae3	286
9fe6733a	287	#define gdbm_sync(db) gdbm_sync(db->dbp)
3b35bae3	288	void
	289	gdbm_sync(db)
	290	GDBM_File db
	291
9fe6733a	292	#define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key)
3b35bae3	293	int
c07a80fd	294	gdbm_EXISTS(db, key)
3b35bae3	295	GDBM_File db
9fe6733a	296	datum_key key
3b35bae3	297
9fe6733a	298	#define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
3b35bae3	299	int
	300	gdbm_setopt (db, optflag, optval, optlen)
	301	GDBM_File db
	302	int optflag
	303	int &optval
	304	int optlen
	305
9fe6733a	306
	307	#define setFilter(type) \
	308	{ \
	309	if (db->type) \
e62f7e43	310	RETVAL = sv_mortalcopy(db->type) ; \
e62f7e43	311	ST(0) = RETVAL ; \
9fe6733a	312	if (db->type && (code == &PL_sv_undef)) { \
	313	SvREFCNT_dec(db->type) ; \
	314	db->type = NULL ; \
	315	} \
	316	else if (code) { \
	317	if (db->type) \
	318	sv_setsv(db->type, code) ; \
	319	else \
	320	db->type = newSVsv(code) ; \
	321	} \
	322	}
	323
	324
	325
	326	SV *
	327	filter_fetch_key(db, code)
	328	GDBM_File db
	329	SV * code
	330	SV * RETVAL = &PL_sv_undef ;
	331	CODE:
	332	setFilter(filter_fetch_key) ;
9fe6733a	333
	334	SV *
	335	filter_store_key(db, code)
	336	GDBM_File db
	337	SV * code
	338	SV * RETVAL = &PL_sv_undef ;
	339	CODE:
	340	setFilter(filter_store_key) ;
9fe6733a	341
	342	SV *
	343	filter_fetch_value(db, code)
	344	GDBM_File db
	345	SV * code
	346	SV * RETVAL = &PL_sv_undef ;
	347	CODE:
	348	setFilter(filter_fetch_value) ;
9fe6733a	349
	350	SV *
	351	filter_store_value(db, code)
	352	GDBM_File db
	353	SV * code
	354	SV * RETVAL = &PL_sv_undef ;
	355	CODE:
	356	setFilter(filter_store_value) ;
9fe6733a	357