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

typedef struct {
	DBM * 	dbp ;
	SV *    filter_fetch_key ;
	SV *    filter_store_key ;
	SV *    filter_fetch_value ;
	SV *    filter_store_value ;
	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)safemalloc(sizeof(SDBM_File_type)) ;
    	        Zero(RETVAL, 1, SDBM_File_type) ;
		RETVAL->dbp = dbp ;
	    }
	    
	}
	OUTPUT:
	  RETVAL

void
sdbm_DESTROY(db)
	SDBM_File	db
	CODE:
	if (db) {
	    sdbm_close(db->dbp);
	    if (db->filter_fetch_key)
		SvREFCNT_dec(db->filter_fetch_key) ;
	    if (db->filter_store_key)
		SvREFCNT_dec(db->filter_store_key) ;
	    if (db->filter_fetch_value)
		SvREFCNT_dec(db->filter_fetch_value) ;
	    if (db->filter_store_value)
		SvREFCNT_dec(db->filter_store_value) ;
	    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
	CODE:
	RETVAL = sdbm_error(db->dbp) ;
	OUTPUT:
	  RETVAL

int
sdbm_clearerr(db)
	SDBM_File	db
	CODE:
	RETVAL = sdbm_clearerr(db->dbp) ;
	OUTPUT:
	  RETVAL


SV *
filter_fetch_key(db, code)
	SDBM_File	db
	SV *		code
	SV *		RETVAL = &PL_sv_undef ;
	CODE:
	    DBM_setFilter(db->filter_fetch_key, code) ;

SV *
filter_store_key(db, code)
	SDBM_File	db
	SV *		code
	SV *		RETVAL =  &PL_sv_undef ;
	CODE:
	    DBM_setFilter(db->filter_store_key, code) ;

SV *
filter_fetch_value(db, code)
	SDBM_File	db
	SV *		code
	SV *		RETVAL =  &PL_sv_undef ;
	CODE:
	    DBM_setFilter(db->filter_fetch_value, code) ;

SV *
filter_store_value(db, code)
	SDBM_File	db
	SV *		code
	SV *		RETVAL =  &PL_sv_undef ;
	CODE:
	    DBM_setFilter(db->filter_store_value, 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
9fe6733a PM	7	typedef struct {
	8	DBM * dbp ;
	9	SV * filter_fetch_key ;
	10	SV * filter_store_key ;
	11	SV * filter_fetch_value ;
	12	SV * filter_store_value ;
	13	int filtering ;
	14	} SDBM_File_type;
	15
	16	typedef SDBM_File_type * SDBM_File ;
	17	typedef datum datum_key ;
	18	typedef datum datum_value ;
	19
a0d0e21e	20	#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
9fe6733a PM	21	#define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key)
	22	#define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags)
	23	#define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key)
	24	#define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key)
	25	#define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp)
	26	#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp)
a0d0e21e LW	27
	28
	29	MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_
	30
	31	SDBM_File
	32	sdbm_TIEHASH(dbtype, filename, flags, mode)
	33	char * dbtype
	34	char * filename
	35	int flags
	36	int mode
9fe6733a PM	37	CODE:
	38	{
	39	DBM * dbp ;
	40
	41	RETVAL = NULL ;
8063af02	42	if ((dbp = sdbm_open(filename,flags,mode))) {
9fe6733a PM	43	RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
	44	Zero(RETVAL, 1, SDBM_File_type) ;
	45	RETVAL->dbp = dbp ;
	46	}
	47
	48	}
	49	OUTPUT:
	50	RETVAL
a0d0e21e LW	51
	52	void
	53	sdbm_DESTROY(db)
	54	SDBM_File db
	55	CODE:
8a0b16eb RGS	56	if (db) {
	57	sdbm_close(db->dbp);
	58	if (db->filter_fetch_key)
	59	SvREFCNT_dec(db->filter_fetch_key) ;
	60	if (db->filter_store_key)
	61	SvREFCNT_dec(db->filter_store_key) ;
	62	if (db->filter_fetch_value)
	63	SvREFCNT_dec(db->filter_fetch_value) ;
	64	if (db->filter_store_value)
	65	SvREFCNT_dec(db->filter_store_value) ;
	66	safefree(db) ;
	67	}
a0d0e21e	68
9fe6733a	69	datum_value
a0d0e21e LW	70	sdbm_FETCH(db, key)
a0d0e21e LW	71	SDBM_File db
9fe6733a	72	datum_key key
a0d0e21e LW	73
	74	int
	75	sdbm_STORE(db, key, value, flags = DBM_REPLACE)
	76	SDBM_File db
9fe6733a PM	77	datum_key key
9fe6733a PM	78	datum_value value
a0d0e21e LW	79	int flags
	80	CLEANUP:
	81	if (RETVAL) {
	82	if (RETVAL < 0 && errno == EPERM)
	83	croak("No write permission to sdbm file");
748a9306	84	croak("sdbm store returned %d, errno %d, key \"%s\"",
a0d0e21e	85	RETVAL,errno,key.dptr);
9fe6733a	86	sdbm_clearerr(db->dbp);
a0d0e21e LW	87	}
	88
	89	int
	90	sdbm_DELETE(db, key)
	91	SDBM_File db
d1a52ffb	92	datum_key key
a0d0e21e	93
f4b9d880 RA	94	int
	95	sdbm_EXISTS(db,key)
	96	SDBM_File db
9fe6733a	97	datum_key key
f4b9d880	98
9fe6733a	99	datum_key
a0d0e21e LW	100	sdbm_FIRSTKEY(db)
	101	SDBM_File db
	102
9fe6733a	103	datum_key
a0d0e21e LW	104	sdbm_NEXTKEY(db, key)
a0d0e21e LW	105	SDBM_File db
aa0165af	106	datum_key key;
a0d0e21e LW	107
	108	int
	109	sdbm_error(db)
	110	SDBM_File db
9fe6733a PM	111	CODE:
	112	RETVAL = sdbm_error(db->dbp) ;
	113	OUTPUT:
	114	RETVAL
a0d0e21e LW	115
	116	int
	117	sdbm_clearerr(db)
	118	SDBM_File db
9fe6733a PM	119	CODE:
	120	RETVAL = sdbm_clearerr(db->dbp) ;
	121	OUTPUT:
	122	RETVAL
	123
	124
9fe6733a PM	125	SV *
	126	filter_fetch_key(db, code)
	127	SDBM_File db
	128	SV * code
	129	SV * RETVAL = &PL_sv_undef ;
	130	CODE:
6a31061a	131	DBM_setFilter(db->filter_fetch_key, code) ;
9fe6733a PM	132
	133	SV *
	134	filter_store_key(db, code)
	135	SDBM_File db
	136	SV * code
	137	SV * RETVAL = &PL_sv_undef ;
	138	CODE:
6a31061a	139	DBM_setFilter(db->filter_store_key, code) ;
9fe6733a PM	140
	141	SV *
	142	filter_fetch_value(db, code)
	143	SDBM_File db
	144	SV * code
	145	SV * RETVAL = &PL_sv_undef ;
	146	CODE:
6a31061a	147	DBM_setFilter(db->filter_fetch_value, code) ;
9fe6733a PM	148
	149	SV *
	150	filter_store_value(db, code)
	151	SDBM_File db
	152	SV * code
	153	SV * RETVAL = &PL_sv_undef ;
	154	CODE:
6a31061a	155	DBM_setFilter(db->filter_store_value, code) ;
a0d0e21e	156