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