[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;

    if (0) {
        goto not_there; /* -Wall */
    }

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
c6c619a9	200	if (0) {
	201	goto not_there; /* -Wall */
	202	}
	203
a0d0e21e	204	not_there:
	205	errno = ENOENT;
	206	return 0;
	207	}
	208
	209	MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_
	210
	211	double
	212	constant(name,arg)
	213	char * name
	214	int arg
	215
	216
	217	GDBM_File
	218	gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
	219	char * dbtype
	220	char * name
	221	int read_write
	222	int mode
	223	FATALFUNC fatal_func
9fe6733a	224	CODE:
	225	{
	226	GDBM_FILE dbp ;
a0d0e21e	227
9fe6733a	228	RETVAL = NULL ;
8063af02	229	if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) {
9fe6733a	230	RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
	231	Zero(RETVAL, 1, GDBM_File_type) ;
	232	RETVAL->dbp = dbp ;
	233	}
	234
	235	}
	236	OUTPUT:
	237	RETVAL
	238
	239
	240	#define gdbm_close(db) gdbm_close(db->dbp)
a0d0e21e	241	void
	242	gdbm_close(db)
	243	GDBM_File db
	244	CLEANUP:
	245
	246	void
	247	gdbm_DESTROY(db)
	248	GDBM_File db
	249	CODE:
	250	gdbm_close(db);
eb99164f	251	safefree(db);
a0d0e21e	252
9fe6733a	253	#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
9fe6733a	254	datum_value
a0d0e21e	255	gdbm_FETCH(db, key)
a0d0e21e	256	GDBM_File db
9fe6733a	257	datum_key key
a0d0e21e	258
9fe6733a	259	#define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags)
a0d0e21e	260	int
	261	gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
	262	GDBM_File db
9fe6733a	263	datum_key key
9fe6733a	264	datum_value value
a0d0e21e	265	int flags
	266	CLEANUP:
	267	if (RETVAL) {
	268	if (RETVAL < 0 && errno == EPERM)
	269	croak("No write permission to gdbm file");
748a9306	270	croak("gdbm store returned %d, errno %d, key \"%.*s\"",
a0d0e21e	271	RETVAL,errno,key.dsize,key.dptr);
a0d0e21e	272	}
a0d0e21e	273
9fe6733a	274	#define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key)
a0d0e21e	275	int
	276	gdbm_DELETE(db, key)
	277	GDBM_File db
9fe6733a	278	datum_key key
a0d0e21e	279
9fe6733a	280	#define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp)
9fe6733a	281	datum_key
a0d0e21e	282	gdbm_FIRSTKEY(db)
	283	GDBM_File db
	284
9fe6733a	285	#define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key)
9fe6733a	286	datum_key
a0d0e21e	287	gdbm_NEXTKEY(db, key)
a0d0e21e	288	GDBM_File db
9fe6733a	289	datum_key key
a0d0e21e	290
9fe6733a	291	#define gdbm_reorganize(db) gdbm_reorganize(db->dbp)
a0d0e21e	292	int
	293	gdbm_reorganize(db)
	294	GDBM_File db
	295
3b35bae3	296
9fe6733a	297	#define gdbm_sync(db) gdbm_sync(db->dbp)
3b35bae3	298	void
	299	gdbm_sync(db)
	300	GDBM_File db
	301
9fe6733a	302	#define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key)
3b35bae3	303	int
c07a80fd	304	gdbm_EXISTS(db, key)
3b35bae3	305	GDBM_File db
9fe6733a	306	datum_key key
3b35bae3	307
9fe6733a	308	#define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
3b35bae3	309	int
	310	gdbm_setopt (db, optflag, optval, optlen)
	311	GDBM_File db
	312	int optflag
	313	int &optval
	314	int optlen
	315
9fe6733a	316
	317	#define setFilter(type) \
	318	{ \
	319	if (db->type) \
e62f7e43	320	RETVAL = sv_mortalcopy(db->type) ; \
e62f7e43	321	ST(0) = RETVAL ; \
9fe6733a	322	if (db->type && (code == &PL_sv_undef)) { \
	323	SvREFCNT_dec(db->type) ; \
	324	db->type = NULL ; \
	325	} \
	326	else if (code) { \
	327	if (db->type) \
	328	sv_setsv(db->type, code) ; \
	329	else \
	330	db->type = newSVsv(code) ; \
	331	} \
	332	}
	333
	334
	335
	336	SV *
	337	filter_fetch_key(db, code)
	338	GDBM_File db
	339	SV * code
	340	SV * RETVAL = &PL_sv_undef ;
	341	CODE:
	342	setFilter(filter_fetch_key) ;
9fe6733a	343
	344	SV *
	345	filter_store_key(db, code)
	346	GDBM_File db
	347	SV * code
	348	SV * RETVAL = &PL_sv_undef ;
	349	CODE:
	350	setFilter(filter_store_key) ;
9fe6733a	351
	352	SV *
	353	filter_fetch_value(db, code)
	354	GDBM_File db
	355	SV * code
	356	SV * RETVAL = &PL_sv_undef ;
	357	CODE:
	358	setFilter(filter_fetch_value) ;
9fe6733a	359
	360	SV *
	361	filter_store_value(db, code)
	362	GDBM_File db
	363	SV * code
	364	SV * RETVAL = &PL_sv_undef ;
	365	CODE:
	366	setFilter(filter_store_value) ;
9fe6733a	367