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

... / ...

Commit	Line	Data
	1	#define PERL_NO_GET_CONTEXT
	2	#include "EXTERN.h"
	3	#include "perl.h"
	4	#include "XSUB.h"
	5	#include "sdbm.h"
	6
	7	#define fetch_key 0
	8	#define store_key 1
	9	#define fetch_value 2
	10	#define store_value 3
	11
	12	typedef struct {
	13	DBM * dbp ;
	14	SV * filter[4];
	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
	22	#define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key)
	23	#define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags)
	24	#define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key)
	25	#define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key)
	26	#define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp)
	27	#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp)
	28
	29
	30	MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_
	31
	32	SDBM_File
	33	sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)
	34	char * dbtype
	35	char * filename
	36	int flags
	37	int mode
	38	char * pagname
	39	CODE:
	40	{
	41	DBM * dbp ;
	42
	43	RETVAL = NULL ;
	44	if (pagname == NULL) {
	45	dbp = sdbm_open(filename, flags, mode);
	46	}
	47	else {
	48	dbp = sdbm_prep(filename, pagname, flags, mode);
	49	}
	50	if (dbp) {
	51	RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
	52	RETVAL->dbp = dbp ;
	53	}
	54
	55	}
	56	OUTPUT:
	57	RETVAL
	58
	59	void
	60	sdbm_DESTROY(db)
	61	SDBM_File db
	62	CODE:
	63	if (db) {
	64	int i = store_value;
	65	sdbm_close(db->dbp);
	66	do {
	67	if (db->filter[i])
	68	SvREFCNT_dec_NN(db->filter[i]);
	69	} while (i-- > 0);
	70	safefree(db) ;
	71	}
	72
	73	datum_value
	74	sdbm_FETCH(db, key)
	75	SDBM_File db
	76	datum_key key
	77
	78	int
	79	sdbm_STORE(db, key, value, flags = DBM_REPLACE)
	80	SDBM_File db
	81	datum_key key
	82	datum_value value
	83	int flags
	84	CLEANUP:
	85	if (RETVAL) {
	86	if (RETVAL < 0 && errno == EPERM)
	87	croak("No write permission to sdbm file");
	88	croak("sdbm store returned %d, errno %d, key \"%s\"",
	89	RETVAL,errno,key.dptr);
	90	sdbm_clearerr(db->dbp);
	91	}
	92
	93	int
	94	sdbm_DELETE(db, key)
	95	SDBM_File db
	96	datum_key key
	97
	98	int
	99	sdbm_EXISTS(db,key)
	100	SDBM_File db
	101	datum_key key
	102
	103	datum_key
	104	sdbm_FIRSTKEY(db)
	105	SDBM_File db
	106
	107	datum_key
	108	sdbm_NEXTKEY(db, key)
	109	SDBM_File db
	110
	111	int
	112	sdbm_error(db)
	113	SDBM_File db
	114	ALIAS:
	115	sdbm_clearerr = 1
	116	CODE:
	117	RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp);
	118	OUTPUT:
	119	RETVAL
	120
	121	SV *
	122	filter_fetch_key(db, code)
	123	SDBM_File db
	124	SV * code
	125	SV * RETVAL = &PL_sv_undef ;
	126	ALIAS:
	127	SDBM_File::filter_fetch_key = fetch_key
	128	SDBM_File::filter_store_key = store_key
	129	SDBM_File::filter_fetch_value = fetch_value
	130	SDBM_File::filter_store_value = store_value
	131	CODE:
	132	DBM_setFilter(db->filter[ix], code);
	133
	134	BOOT:
	135	{
	136	HV *stash = gv_stashpvs("SDBM_File", 1);
	137	newCONSTSUB(stash, "PAGFEXT", newSVpvs(PAGFEXT));
	138	newCONSTSUB(stash, "DIRFEXT", newSVpvs(DIRFEXT));
	139	newCONSTSUB(stash, "PAIRMAX", newSVuv(PAIRMAX));
	140	}