[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_NOLOCK"))
#ifdef GDBM_NOLOCK
	    return GDBM_NOLOCK;
#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
8722d079	127	if (strEQ(name, "GDBM_NOLOCK"))
	128	#ifdef GDBM_NOLOCK
	129	return GDBM_NOLOCK;
	130	#else
	131	goto not_there;
	132	#endif
a0d0e21e	133	if (strEQ(name, "GDBM_READER"))
	134	#ifdef GDBM_READER
	135	return GDBM_READER;
	136	#else
	137	goto not_there;
	138	#endif
	139	if (strEQ(name, "GDBM_REPLACE"))
	140	#ifdef GDBM_REPLACE
	141	return GDBM_REPLACE;
	142	#else
	143	goto not_there;
	144	#endif
	145	if (strEQ(name, "GDBM_WRCREAT"))
	146	#ifdef GDBM_WRCREAT
	147	return GDBM_WRCREAT;
	148	#else
	149	goto not_there;
	150	#endif
	151	if (strEQ(name, "GDBM_WRITER"))
	152	#ifdef GDBM_WRITER
	153	return GDBM_WRITER;
	154	#else
	155	goto not_there;
	156	#endif
	157	break;
	158	case 'H':
	159	break;
	160	case 'I':
	161	break;
	162	case 'J':
	163	break;
	164	case 'K':
	165	break;
	166	case 'L':
	167	break;
	168	case 'M':
	169	break;
	170	case 'N':
	171	break;
	172	case 'O':
	173	break;
	174	case 'P':
	175	break;
	176	case 'Q':
	177	break;
	178	case 'R':
	179	break;
	180	case 'S':
	181	break;
	182	case 'T':
	183	break;
	184	case 'U':
	185	break;
	186	case 'V':
	187	break;
	188	case 'W':
	189	break;
	190	case 'X':
	191	break;
	192	case 'Y':
	193	break;
	194	case 'Z':
	195	break;
	196	}
197	errno = EINVAL;
198	return 0;
199
200	not_there:
201	errno = ENOENT;
202	return 0;
203	}
204
205	MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_
206
207	double
208	constant(name,arg)
209	char * name
210	int arg
211
212
213	GDBM_File
214	gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
215	char * dbtype
216	char * name
217	int read_write
218	int mode
219	FATALFUNC fatal_func
9fe6733a	220	CODE:
	221	{
	222	GDBM_FILE dbp ;
a0d0e21e	223
9fe6733a	224	RETVAL = NULL ;
8063af02	225	if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) {
9fe6733a	226	RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
	227	Zero(RETVAL, 1, GDBM_File_type) ;
	228	RETVAL->dbp = dbp ;
	229	}
	230
	231	}
	232	OUTPUT:
	233	RETVAL
	234
	235
	236	#define gdbm_close(db) gdbm_close(db->dbp)
a0d0e21e	237	void
	238	gdbm_close(db)
	239	GDBM_File db
	240	CLEANUP:
	241
	242	void
	243	gdbm_DESTROY(db)
	244	GDBM_File db
	245	CODE:
	246	gdbm_close(db);
eb99164f	247	safefree(db);
a0d0e21e	248
9fe6733a	249	#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
9fe6733a	250	datum_value
a0d0e21e	251	gdbm_FETCH(db, key)
a0d0e21e	252	GDBM_File db
9fe6733a	253	datum_key key
a0d0e21e	254
9fe6733a	255	#define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags)
a0d0e21e	256	int
	257	gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
	258	GDBM_File db
9fe6733a	259	datum_key key
9fe6733a	260	datum_value value
a0d0e21e	261	int flags
	262	CLEANUP:
	263	if (RETVAL) {
	264	if (RETVAL < 0 && errno == EPERM)
	265	croak("No write permission to gdbm file");
748a9306	266	croak("gdbm store returned %d, errno %d, key \"%.*s\"",
a0d0e21e	267	RETVAL,errno,key.dsize,key.dptr);
a0d0e21e	268	}
a0d0e21e	269
9fe6733a	270	#define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key)
a0d0e21e	271	int
	272	gdbm_DELETE(db, key)
	273	GDBM_File db
9fe6733a	274	datum_key key
a0d0e21e	275
9fe6733a	276	#define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp)
9fe6733a	277	datum_key
a0d0e21e	278	gdbm_FIRSTKEY(db)
	279	GDBM_File db
	280
9fe6733a	281	#define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key)
9fe6733a	282	datum_key
a0d0e21e	283	gdbm_NEXTKEY(db, key)
a0d0e21e	284	GDBM_File db
9fe6733a	285	datum_key key
a0d0e21e	286
9fe6733a	287	#define gdbm_reorganize(db) gdbm_reorganize(db->dbp)
a0d0e21e	288	int
	289	gdbm_reorganize(db)
	290	GDBM_File db
	291
3b35bae3	292
9fe6733a	293	#define gdbm_sync(db) gdbm_sync(db->dbp)
3b35bae3	294	void
	295	gdbm_sync(db)
	296	GDBM_File db
	297
9fe6733a	298	#define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key)
3b35bae3	299	int
c07a80fd	300	gdbm_EXISTS(db, key)
3b35bae3	301	GDBM_File db
9fe6733a	302	datum_key key
3b35bae3	303
9fe6733a	304	#define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
3b35bae3	305	int
	306	gdbm_setopt (db, optflag, optval, optlen)
	307	GDBM_File db
	308	int optflag
	309	int &optval
	310	int optlen
	311
9fe6733a	312
	313	#define setFilter(type) \
	314	{ \
	315	if (db->type) \
e62f7e43	316	RETVAL = sv_mortalcopy(db->type) ; \
e62f7e43	317	ST(0) = RETVAL ; \
9fe6733a	318	if (db->type && (code == &PL_sv_undef)) { \
	319	SvREFCNT_dec(db->type) ; \
	320	db->type = NULL ; \
	321	} \
	322	else if (code) { \
	323	if (db->type) \
	324	sv_setsv(db->type, code) ; \
	325	else \
	326	db->type = newSVsv(code) ; \
	327	} \
	328	}
	329
	330
	331
	332	SV *
	333	filter_fetch_key(db, code)
	334	GDBM_File db
	335	SV * code
	336	SV * RETVAL = &PL_sv_undef ;
	337	CODE:
	338	setFilter(filter_fetch_key) ;
9fe6733a	339
	340	SV *
	341	filter_store_key(db, code)
	342	GDBM_File db
	343	SV * code
	344	SV * RETVAL = &PL_sv_undef ;
	345	CODE:
	346	setFilter(filter_store_key) ;
9fe6733a	347
	348	SV *
	349	filter_fetch_value(db, code)
	350	GDBM_File db
	351	SV * code
	352	SV * RETVAL = &PL_sv_undef ;
	353	CODE:
	354	setFilter(filter_fetch_value) ;
9fe6733a	355
	356	SV *
	357	filter_store_value(db, code)
	358	GDBM_File db
	359	SV * code
	360	SV * RETVAL = &PL_sv_undef ;
	361	CODE:
	362	setFilter(filter_store_value) ;
9fe6733a	363