perl5.git.perl.org Git - perl5.git/blame_incremental

... / ...

Commit	Line	Data
	1	#include "EXTERN.h"
	2	#include "perl.h"
	3	#include "XSUB.h"
	4	#include <ndbm.h>
	5
	6	typedef struct {
	7	DBM * dbp ;
	8	SV * filter_fetch_key ;
	9	SV * filter_store_key ;
	10	SV * filter_fetch_value ;
	11	SV * filter_store_value ;
	12	int filtering ;
	13	} NDBM_File_type;
	14
	15	typedef NDBM_File_type * NDBM_File ;
	16	typedef datum datum_key ;
	17	typedef datum datum_value ;
	18
	19	#define ckFilter(arg,type,name) \
	20	if (db->type) { \
	21	SV * save_defsv ; \
	22	/* printf("filtering %s\n", name) ;*/ \
	23	if (db->filtering) \
	24	croak("recursion detected in %s", name) ; \
	25	db->filtering = TRUE ; \
	26	save_defsv = newSVsv(DEFSV) ; \
	27	sv_setsv(DEFSV, arg) ; \
	28	PUSHMARK(sp) ; \
	29	(void) perl_call_sv(db->type, G_DISCARD\|G_NOARGS); \
	30	sv_setsv(arg, DEFSV) ; \
	31	sv_setsv(DEFSV, save_defsv) ; \
	32	SvREFCNT_dec(save_defsv) ; \
	33	db->filtering = FALSE ; \
	34	/printf("end of filtering %s\n", name) ;/ \
	35	}
	36
	37
	38	MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = ndbm_
	39
	40	NDBM_File
	41	ndbm_TIEHASH(dbtype, filename, flags, mode)
	42	char * dbtype
	43	char * filename
	44	int flags
	45	int mode
	46	CODE:
	47	{
	48	DBM * dbp ;
	49
	50	RETVAL = NULL ;
	51	if (dbp = dbm_open(filename, flags, mode)) {
	52	RETVAL = (NDBM_File)safemalloc(sizeof(NDBM_File_type)) ;
	53	Zero(RETVAL, 1, NDBM_File_type) ;
	54	RETVAL->dbp = dbp ;
	55	}
	56
	57	}
	58	OUTPUT:
	59	RETVAL
	60
	61	void
	62	ndbm_DESTROY(db)
	63	NDBM_File db
	64	CODE:
	65	dbm_close(db->dbp);
	66	safefree(db);
	67
	68	#define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key)
	69	datum_value
	70	ndbm_FETCH(db, key)
	71	NDBM_File db
	72	datum_key key
	73
	74	#define ndbm_STORE(db,key,value,flags) dbm_store(db->dbp,key,value,flags)
	75	int
	76	ndbm_STORE(db, key, value, flags = DBM_REPLACE)
	77	NDBM_File db
	78	datum_key key
	79	datum_value value
	80	int flags
	81	CLEANUP:
	82	if (RETVAL) {
	83	if (RETVAL < 0 && errno == EPERM)
	84	croak("No write permission to ndbm file");
	85	croak("ndbm store returned %d, errno %d, key \"%s\"",
	86	RETVAL,errno,key.dptr);
	87	dbm_clearerr(db->dbp);
	88	}
	89
	90	#define ndbm_DELETE(db,key) dbm_delete(db->dbp,key)
	91	int
	92	ndbm_DELETE(db, key)
	93	NDBM_File db
	94	datum_key key
	95
	96	#define ndbm_FIRSTKEY(db) dbm_firstkey(db->dbp)
	97	datum_key
	98	ndbm_FIRSTKEY(db)
	99	NDBM_File db
	100
	101	#define ndbm_NEXTKEY(db,key) dbm_nextkey(db->dbp)
	102	datum_key
	103	ndbm_NEXTKEY(db, key)
	104	NDBM_File db
	105	datum_key key
	106
	107	#define ndbm_error(db) dbm_error(db->dbp)
	108	int
	109	ndbm_error(db)
	110	NDBM_File db
	111
	112	#define ndbm_clearerr(db) dbm_clearerr(db->dbp)
	113	void
	114	ndbm_clearerr(db)
	115	NDBM_File db
	116
	117
	118	#define setFilter(type) \
	119	{ \
	120	if (db->type) \
	121	RETVAL = sv_mortalcopy(db->type) ; \
	122	ST(0) = RETVAL ; \
	123	if (db->type && (code == &PL_sv_undef)) { \
	124	SvREFCNT_dec(db->type) ; \
	125	db->type = NULL ; \
	126	} \
	127	else if (code) { \
	128	if (db->type) \
	129	sv_setsv(db->type, code) ; \
	130	else \
	131	db->type = newSVsv(code) ; \
	132	} \
	133	}
	134
	135
	136
	137	SV *
	138	filter_fetch_key(db, code)
	139	NDBM_File db
	140	SV * code
	141	SV * RETVAL = &PL_sv_undef ;
	142	CODE:
	143	setFilter(filter_fetch_key) ;
	144
	145	SV *
	146	filter_store_key(db, code)
	147	NDBM_File db
	148	SV * code
	149	SV * RETVAL = &PL_sv_undef ;
	150	CODE:
	151	setFilter(filter_store_key) ;
	152
	153	SV *
	154	filter_fetch_value(db, code)
	155	NDBM_File db
	156	SV * code
	157	SV * RETVAL = &PL_sv_undef ;
	158	CODE:
	159	setFilter(filter_fetch_value) ;
	160
	161	SV *
	162	filter_store_value(db, code)
	163	NDBM_File db
	164	SV * code
	165	SV * RETVAL = &PL_sv_undef ;
	166	CODE:
	167	setFilter(filter_store_value) ;
	168