1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5 #include "sdbm/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_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
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)
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
39 	CODE:
40 	{
41 	    DBM * 	dbp ;
42 
43 	    RETVAL = NULL ;
44 	    if ((dbp = sdbm_open(filename,flags,mode))) {
45 	        RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
46 		RETVAL->dbp = dbp ;
47 	    }
48 
49 	}
50 	OUTPUT:
51 	  RETVAL
52 
53 void
54 sdbm_DESTROY(db)
55 	SDBM_File	db
56 	CODE:
57 	if (db) {
58 	    int i = store_value;
59 	    sdbm_close(db->dbp);
60 	    do {
61 		if (db->filter[i])
62 		    SvREFCNT_dec(db->filter[i]);
63 	    } while (i-- > 0);
64 	    safefree(db) ;
65 	}
66 
67 datum_value
68 sdbm_FETCH(db, key)
69 	SDBM_File	db
70 	datum_key	key
71 
72 int
73 sdbm_STORE(db, key, value, flags = DBM_REPLACE)
74 	SDBM_File	db
75 	datum_key	key
76 	datum_value	value
77 	int		flags
78     CLEANUP:
79 	if (RETVAL) {
80 	    if (RETVAL < 0 && errno == EPERM)
81 		croak("No write permission to sdbm file");
82 	    croak("sdbm store returned %d, errno %d, key \"%s\"",
83 			RETVAL,errno,key.dptr);
84 	    sdbm_clearerr(db->dbp);
85 	}
86 
87 int
88 sdbm_DELETE(db, key)
89 	SDBM_File	db
90 	datum_key	key
91 
92 int
93 sdbm_EXISTS(db,key)
94 	SDBM_File	db
95 	datum_key	key
96 
97 datum_key
98 sdbm_FIRSTKEY(db)
99 	SDBM_File	db
100 
101 datum_key
102 sdbm_NEXTKEY(db, key)
103 	SDBM_File	db
104 	datum_key	key;
105 
106 int
107 sdbm_error(db)
108 	SDBM_File	db
109 	ALIAS:
110 	sdbm_clearerr = 1
111 	CODE:
112 	RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp);
113 	OUTPUT:
114 	  RETVAL
115 
116 SV *
117 filter_fetch_key(db, code)
118 	SDBM_File	db
119 	SV *		code
120 	SV *		RETVAL = &PL_sv_undef ;
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
126 	CODE:
127 	    DBM_setFilter(db->filter[ix], code);
128