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 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
20 #define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
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)
27
28
29 MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_
30
31 SDBM_File
sdbm_TIEHASH(dbtype,filename,flags,mode)32 sdbm_TIEHASH(dbtype, filename, flags, mode)
33 char * dbtype
34 char * filename
35 int flags
36 int mode
37 CODE:
38 {
39 DBM * dbp ;
40
41 RETVAL = NULL ;
42 if ((dbp = sdbm_open(filename,flags,mode))) {
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
51
52 void
53 sdbm_DESTROY(db)
54 SDBM_File db
55 CODE:
56 sdbm_close(db->dbp);
57 if (db->filter_fetch_key)
58 SvREFCNT_dec(db->filter_fetch_key) ;
59 if (db->filter_store_key)
60 SvREFCNT_dec(db->filter_store_key) ;
61 if (db->filter_fetch_value)
62 SvREFCNT_dec(db->filter_fetch_value) ;
63 if (db->filter_store_value)
64 SvREFCNT_dec(db->filter_store_value) ;
65 safefree(db) ;
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 CODE:
110 RETVAL = sdbm_error(db->dbp) ;
111 OUTPUT:
112 RETVAL
113
114 int
115 sdbm_clearerr(db)
116 SDBM_File db
117 CODE:
118 RETVAL = sdbm_clearerr(db->dbp) ;
119 OUTPUT:
120 RETVAL
121
122
123 SV *
124 filter_fetch_key(db, code)
125 SDBM_File db
126 SV * code
127 SV * RETVAL = &PL_sv_undef ;
128 CODE:
129 DBM_setFilter(db->filter_fetch_key, code) ;
130
131 SV *
132 filter_store_key(db, code)
133 SDBM_File db
134 SV * code
135 SV * RETVAL = &PL_sv_undef ;
136 CODE:
137 DBM_setFilter(db->filter_store_key, code) ;
138
139 SV *
140 filter_fetch_value(db, code)
141 SDBM_File db
142 SV * code
143 SV * RETVAL = &PL_sv_undef ;
144 CODE:
145 DBM_setFilter(db->filter_fetch_value, code) ;
146
147 SV *
148 filter_store_value(db, code)
149 SDBM_File db
150 SV * code
151 SV * RETVAL = &PL_sv_undef ;
152 CODE:
153 DBM_setFilter(db->filter_store_value, code) ;
154
155