[perl5.git] / ext / SDBM_File / SDBM_File.xs

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "sdbm/sdbm.h"

#define fetch_key 0
#define store_key 1
#define fetch_value 2
#define store_value 3

typedef struct {
	DBM * 	dbp ;
	SV *    filter[4];
	int     filtering ;
	} SDBM_File_type;

typedef SDBM_File_type * SDBM_File ;
typedef datum datum_key ;
typedef datum datum_value ;

#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
#define sdbm_FETCH(db,key)			sdbm_fetch(db->dbp,key)
#define sdbm_STORE(db,key,value,flags)		sdbm_store(db->dbp,key,value,flags)
#define sdbm_DELETE(db,key)			sdbm_delete(db->dbp,key)
#define sdbm_EXISTS(db,key)			sdbm_exists(db->dbp,key)
#define sdbm_FIRSTKEY(db)			sdbm_firstkey(db->dbp)
#define sdbm_NEXTKEY(db,key)			sdbm_nextkey(db->dbp)


MODULE = SDBM_File	PACKAGE = SDBM_File	PREFIX = sdbm_

SDBM_File
sdbm_TIEHASH(dbtype, filename, flags, mode)
	char *		dbtype
	char *		filename
	int		flags
	int		mode
	CODE:
	{
	    DBM * 	dbp ;

	    RETVAL = NULL ;
	    if ((dbp = sdbm_open(filename,flags,mode))) {
	        RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
		RETVAL->dbp = dbp ;
	    }
	    
	}
	OUTPUT:
	  RETVAL

void
sdbm_DESTROY(db)
	SDBM_File	db
	CODE:
	if (db) {
	    int i = store_value;
	    sdbm_close(db->dbp);
	    do {
		if (db->filter[i])
		    SvREFCNT_dec(db->filter[i]);
	    } while (i-- > 0);
	    safefree(db) ;
	}

datum_value
sdbm_FETCH(db, key)
	SDBM_File	db
	datum_key	key

int
sdbm_STORE(db, key, value, flags = DBM_REPLACE)
	SDBM_File	db
	datum_key	key
	datum_value	value
	int		flags
    CLEANUP:
	if (RETVAL) {
	    if (RETVAL < 0 && errno == EPERM)
		croak("No write permission to sdbm file");
	    croak("sdbm store returned %d, errno %d, key \"%s\"",
			RETVAL,errno,key.dptr);
	    sdbm_clearerr(db->dbp);
	}

int
sdbm_DELETE(db, key)
	SDBM_File	db
	datum_key	key

int
sdbm_EXISTS(db,key)
	SDBM_File	db
	datum_key	key

datum_key
sdbm_FIRSTKEY(db)
	SDBM_File	db

datum_key
sdbm_NEXTKEY(db, key)
	SDBM_File	db
	datum_key	key;

int
sdbm_error(db)
	SDBM_File	db
	ALIAS:
	sdbm_clearerr = 1
	CODE:
	RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp);
	OUTPUT:
	  RETVAL

SV *
filter_fetch_key(db, code)
	SDBM_File	db
	SV *		code
	SV *		RETVAL = &PL_sv_undef ;
	ALIAS:
	SDBM_File::filter_fetch_key = fetch_key
	SDBM_File::filter_store_key = store_key
	SDBM_File::filter_fetch_value = fetch_value
	SDBM_File::filter_store_value = store_value
	CODE:
	    DBM_setFilter(db->filter[ix], code);
Commit	Line	Data
c5be433b	1	#define PERL_NO_GET_CONTEXT
a0d0e21e LW	2	#include "EXTERN.h"
	3	#include "perl.h"
	4	#include "XSUB.h"
	5	#include "sdbm/sdbm.h"
	6
f4603e30 NC	7	#define fetch_key 0
	8	#define store_key 1
	9	#define fetch_value 2
	10	#define store_value 3
	11
9fe6733a PM	12	typedef struct {
9fe6733a PM	13	DBM * dbp ;
f4603e30	14	SV * filter[4];
9fe6733a PM	15	int filtering ;
	16	} SDBM_File_type;
	17
	18	typedef SDBM_File_type * SDBM_File ;
	19	typedef datum datum_key ;
	20	typedef datum datum_value ;
	21
a0d0e21e	22	#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
9fe6733a PM	23	#define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key)
	24	#define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags)
	25	#define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key)
	26	#define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key)
	27	#define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp)
	28	#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp)
a0d0e21e LW	29
	30
	31	MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_
	32
	33	SDBM_File
	34	sdbm_TIEHASH(dbtype, filename, flags, mode)
	35	char * dbtype
	36	char * filename
	37	int flags
	38	int mode
9fe6733a PM	39	CODE:
	40	{
	41	DBM * dbp ;
	42
	43	RETVAL = NULL ;
8063af02	44	if ((dbp = sdbm_open(filename,flags,mode))) {
a5c6857c	45	RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
9fe6733a PM	46	RETVAL->dbp = dbp ;
	47	}
	48
	49	}
	50	OUTPUT:
	51	RETVAL
a0d0e21e LW	52
	53	void
	54	sdbm_DESTROY(db)
	55	SDBM_File db
	56	CODE:
8a0b16eb	57	if (db) {
f4603e30	58	int i = store_value;
8a0b16eb	59	sdbm_close(db->dbp);
f4603e30 NC	60	do {
	61	if (db->filter[i])
	62	SvREFCNT_dec(db->filter[i]);
	63	} while (i-- > 0);
8a0b16eb RGS	64	safefree(db) ;
8a0b16eb RGS	65	}
a0d0e21e	66
9fe6733a	67	datum_value
a0d0e21e LW	68	sdbm_FETCH(db, key)
a0d0e21e LW	69	SDBM_File db
9fe6733a	70	datum_key key
a0d0e21e LW	71
	72	int
	73	sdbm_STORE(db, key, value, flags = DBM_REPLACE)
	74	SDBM_File db
9fe6733a PM	75	datum_key key
9fe6733a PM	76	datum_value value
a0d0e21e LW	77	int flags
	78	CLEANUP:
	79	if (RETVAL) {
	80	if (RETVAL < 0 && errno == EPERM)
	81	croak("No write permission to sdbm file");
748a9306	82	croak("sdbm store returned %d, errno %d, key \"%s\"",
a0d0e21e	83	RETVAL,errno,key.dptr);
9fe6733a	84	sdbm_clearerr(db->dbp);
a0d0e21e LW	85	}
	86
	87	int
	88	sdbm_DELETE(db, key)
	89	SDBM_File db
d1a52ffb	90	datum_key key
a0d0e21e	91
f4b9d880 RA	92	int
	93	sdbm_EXISTS(db,key)
	94	SDBM_File db
9fe6733a	95	datum_key key
f4b9d880	96
9fe6733a	97	datum_key
a0d0e21e LW	98	sdbm_FIRSTKEY(db)
	99	SDBM_File db
	100
9fe6733a	101	datum_key
a0d0e21e LW	102	sdbm_NEXTKEY(db, key)
a0d0e21e LW	103	SDBM_File db
aa0165af	104	datum_key key;
a0d0e21e LW	105
	106	int
	107	sdbm_error(db)
	108	SDBM_File db
157486ae NC	109	ALIAS:
157486ae NC	110	sdbm_clearerr = 1
9fe6733a	111	CODE:
157486ae	112	RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp);
9fe6733a PM	113	OUTPUT:
	114	RETVAL
	115
9fe6733a PM	116	SV *
	117	filter_fetch_key(db, code)
	118	SDBM_File db
	119	SV * code
	120	SV * RETVAL = &PL_sv_undef ;
f4603e30 NC	121	ALIAS:
	122	SDBM_File::filter_fetch_key = fetch_key
	123	SDBM_File::filter_store_key = store_key
	124	SDBM_File::filter_fetch_value = fetch_value
	125	SDBM_File::filter_store_value = store_value
9fe6733a	126	CODE:
f4603e30	127	DBM_setFilter(db->filter[ix], code);