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