Commit | Line | Data |
---|---|---|
040eaf47 NC |
1 | #define PERL_NO_GET_CONTEXT |
2 | ||
463ee0b2 LW |
3 | #include "EXTERN.h" |
4 | #include "perl.h" | |
5 | #include "XSUB.h" | |
6 | ||
8e07c86e AD |
7 | #ifdef I_DBM |
8 | # include <dbm.h> | |
9 | #else | |
10 | # ifdef I_RPCSVC_DBM | |
11 | # include <rpcsvc/dbm.h> | |
12 | # endif | |
13 | #endif | |
463ee0b2 | 14 | |
2ef53570 JH |
15 | #ifndef HAS_DBMINIT_PROTO |
16 | int dbminit(char* filename); | |
17 | int dbmclose(void); | |
18 | datum fetch(datum key); | |
19 | int store(datum key, datum dat); | |
eb5402b2 | 20 | int delete(datum key); |
2ef53570 JH |
21 | datum firstkey(void); |
22 | datum nextkey(datum key); | |
23 | #endif | |
24 | ||
1639c7b3 | 25 | #ifdef DBM_BUG_DUPLICATE_FREE |
26 | /* | |
27 | * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(), | |
28 | * resulting in duplicate free() because dbmclose() does *not* | |
29 | * check if it has already been called for this DBM. | |
30 | * If some malloc/free calls have been done between dbmclose() and | |
31 | * the next dbminit(), the memory might be used for something else when | |
32 | * it is freed. | |
33 | * Verified to work on ultrix4.3. Probably will work on HP/UX. | |
34 | * Set DBM_BUG_DUPLICATE_FREE in the extension hint file. | |
35 | */ | |
36 | /* Close the previous dbm, and fail to open a new dbm */ | |
2359510d | 37 | #define dbmclose() ((void) dbminit("/non/exist/ent")) |
1639c7b3 | 38 | #endif |
39 | ||
463ee0b2 LW |
40 | #include <fcntl.h> |
41 | ||
a4051d29 NC |
42 | #define fetch_key 0 |
43 | #define store_key 1 | |
44 | #define fetch_value 2 | |
45 | #define store_value 3 | |
46 | ||
9fe6733a PM |
47 | typedef struct { |
48 | void * dbp ; | |
a4051d29 | 49 | SV * filter[4]; |
9fe6733a PM |
50 | int filtering ; |
51 | } ODBM_File_type; | |
52 | ||
53 | typedef ODBM_File_type * ODBM_File ; | |
54 | typedef datum datum_key ; | |
0bf2e707 | 55 | typedef datum datum_key_copy ; |
9fe6733a PM |
56 | typedef datum datum_value ; |
57 | ||
a0d0e21e LW |
58 | #define odbm_FETCH(db,key) fetch(key) |
59 | #define odbm_STORE(db,key,value,flags) store(key,value) | |
2b9198b7 | 60 | #define odbm_DELETE(db,key) delete(key) |
a0d0e21e LW |
61 | #define odbm_FIRSTKEY(db) firstkey() |
62 | #define odbm_NEXTKEY(db,key) nextkey(key) | |
463ee0b2 | 63 | |
df3728a2 JH |
64 | #define MY_CXT_KEY "ODBM_File::_guts" XS_VERSION |
65 | ||
66 | typedef struct { | |
67 | int x_dbmrefcnt; | |
68 | } my_cxt_t; | |
69 | ||
70 | START_MY_CXT | |
71 | ||
72 | #define dbmrefcnt (MY_CXT.x_dbmrefcnt) | |
463ee0b2 | 73 | |
85e6fe83 | 74 | #ifndef DBM_REPLACE |
463ee0b2 | 75 | #define DBM_REPLACE 0 |
85e6fe83 | 76 | #endif |
463ee0b2 LW |
77 | |
78 | MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_ | |
79 | ||
df3728a2 JH |
80 | BOOT: |
81 | { | |
82 | MY_CXT_INIT; | |
83 | } | |
84 | ||
463ee0b2 | 85 | ODBM_File |
a0d0e21e | 86 | odbm_TIEHASH(dbtype, filename, flags, mode) |
463ee0b2 LW |
87 | char * dbtype |
88 | char * filename | |
89 | int flags | |
90 | int mode | |
91 | CODE: | |
92 | { | |
46fc3d4c | 93 | char *tmpbuf; |
9fe6733a | 94 | void * dbp ; |
df3728a2 JH |
95 | dMY_CXT; |
96 | ||
463ee0b2 LW |
97 | if (dbmrefcnt++) |
98 | croak("Old dbm can only open one database"); | |
a02a5408 | 99 | Newx(tmpbuf, strlen(filename) + 5, char); |
46fc3d4c | 100 | SAVEFREEPV(tmpbuf); |
463ee0b2 | 101 | sprintf(tmpbuf,"%s.dir",filename); |
3280af22 | 102 | if (stat(tmpbuf, &PL_statbuf) < 0) { |
463ee0b2 LW |
103 | if (flags & O_CREAT) { |
104 | if (mode < 0 || close(creat(tmpbuf,mode)) < 0) | |
105 | croak("ODBM_File: Can't create %s", filename); | |
106 | sprintf(tmpbuf,"%s.pag",filename); | |
107 | if (close(creat(tmpbuf,mode)) < 0) | |
108 | croak("ODBM_File: Can't create %s", filename); | |
109 | } | |
110 | else | |
111 | croak("ODBM_FILE: Can't open %s", filename); | |
112 | } | |
9fe6733a | 113 | dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); |
a5c6857c | 114 | RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type)); |
9fe6733a | 115 | RETVAL->dbp = dbp ; |
463ee0b2 | 116 | } |
666c7ca6 NC |
117 | OUTPUT: |
118 | RETVAL | |
463ee0b2 LW |
119 | |
120 | void | |
121 | DESTROY(db) | |
122 | ODBM_File db | |
df3728a2 JH |
123 | PREINIT: |
124 | dMY_CXT; | |
a4051d29 | 125 | int i = store_value; |
463ee0b2 LW |
126 | CODE: |
127 | dbmrefcnt--; | |
128 | dbmclose(); | |
a4051d29 NC |
129 | do { |
130 | if (db->filter[i]) | |
131 | SvREFCNT_dec(db->filter[i]); | |
132 | } while (i-- > 0); | |
eb99164f | 133 | safefree(db); |
463ee0b2 | 134 | |
1b882d32 | 135 | datum_value |
a0d0e21e | 136 | odbm_FETCH(db, key) |
463ee0b2 | 137 | ODBM_File db |
0bf2e707 | 138 | datum_key_copy key |
463ee0b2 LW |
139 | |
140 | int | |
a0d0e21e | 141 | odbm_STORE(db, key, value, flags = DBM_REPLACE) |
463ee0b2 | 142 | ODBM_File db |
9fe6733a PM |
143 | datum_key key |
144 | datum_value value | |
463ee0b2 | 145 | int flags |
a0d0e21e LW |
146 | CLEANUP: |
147 | if (RETVAL) { | |
148 | if (RETVAL < 0 && errno == EPERM) | |
149 | croak("No write permission to odbm file"); | |
748a9306 | 150 | croak("odbm store returned %d, errno %d, key \"%s\"", |
a0d0e21e LW |
151 | RETVAL,errno,key.dptr); |
152 | } | |
463ee0b2 LW |
153 | |
154 | int | |
a0d0e21e | 155 | odbm_DELETE(db, key) |
463ee0b2 | 156 | ODBM_File db |
9fe6733a | 157 | datum_key key |
463ee0b2 | 158 | |
9fe6733a | 159 | datum_key |
a0d0e21e | 160 | odbm_FIRSTKEY(db) |
463ee0b2 LW |
161 | ODBM_File db |
162 | ||
9fe6733a | 163 | datum_key |
a0d0e21e | 164 | odbm_NEXTKEY(db, key) |
463ee0b2 | 165 | ODBM_File db |
9fe6733a PM |
166 | datum_key key |
167 | ||
168 | ||
169 | #define setFilter(type) \ | |
170 | { \ | |
171 | if (db->type) \ | |
cad2e5aa JH |
172 | RETVAL = sv_mortalcopy(db->type) ; \ |
173 | ST(0) = RETVAL ; \ | |
9fe6733a PM |
174 | if (db->type && (code == &PL_sv_undef)) { \ |
175 | SvREFCNT_dec(db->type) ; \ | |
1b882d32 | 176 | db->type = Nullsv ; \ |
9fe6733a PM |
177 | } \ |
178 | else if (code) { \ | |
179 | if (db->type) \ | |
180 | sv_setsv(db->type, code) ; \ | |
181 | else \ | |
182 | db->type = newSVsv(code) ; \ | |
183 | } \ | |
184 | } | |
185 | ||
186 | ||
187 | ||
188 | SV * | |
189 | filter_fetch_key(db, code) | |
190 | ODBM_File db | |
191 | SV * code | |
192 | SV * RETVAL = &PL_sv_undef ; | |
a4051d29 NC |
193 | ALIAS: |
194 | ODBM_File::filter_fetch_key = fetch_key | |
195 | ODBM_File::filter_store_key = store_key | |
196 | ODBM_File::filter_fetch_value = fetch_value | |
197 | ODBM_File::filter_store_value = store_value | |
9fe6733a | 198 | CODE: |
a4051d29 | 199 | DBM_setFilter(db->filter[ix], code); |