| 1 |
#include "EXTERN.h" |
| 2 |
#include "perl.h" |
| 3 |
#include "XSUB.h" |
| 4 |
|
| 5 |
#include <gdbm.h> |
| 6 |
#include <fcntl.h> |
| 7 |
|
| 8 |
typedef struct { |
| 9 |
GDBM_FILE dbp ; |
| 10 |
SV * filter_fetch_key ; |
| 11 |
SV * filter_store_key ; |
| 12 |
SV * filter_fetch_value ; |
| 13 |
SV * filter_store_value ; |
| 14 |
int filtering ; |
| 15 |
} GDBM_File_type; |
| 16 |
|
| 17 |
typedef GDBM_File_type * GDBM_File ; |
| 18 |
typedef datum datum_key ; |
| 19 |
typedef datum datum_value ; |
| 20 |
typedef datum datum_key_copy; |
| 21 |
|
| 22 |
#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */ |
| 23 |
|
| 24 |
typedef void (*FATALFUNC)(); |
| 25 |
|
| 26 |
#ifndef GDBM_FAST |
| 27 |
static int |
| 28 |
not_here(char *s) |
| 29 |
{ |
| 30 |
croak("GDBM_File::%s not implemented on this architecture", s); |
| 31 |
return -1; |
| 32 |
} |
| 33 |
#endif |
| 34 |
|
| 35 |
/* GDBM allocates the datum with system malloc() and expects the user |
| 36 |
* to free() it. So we either have to free() it immediately, or have |
| 37 |
* perl free() it when it deallocates the SV, depending on whether |
| 38 |
* perl uses malloc()/free() or not. */ |
| 39 |
static void |
| 40 |
output_datum(pTHX_ SV *arg, char *str, int size) |
| 41 |
{ |
| 42 |
#if (!defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))) |
| 43 |
sv_usepvn(arg, str, size); |
| 44 |
#else |
| 45 |
sv_setpvn(arg, str, size); |
| 46 |
safesysfree(str); |
| 47 |
#endif |
| 48 |
} |
| 49 |
|
| 50 |
/* Versions of gdbm prior to 1.7x might not have the gdbm_sync, |
| 51 |
gdbm_exists, and gdbm_setopt functions. Apparently Slackware |
| 52 |
(Linux) 2.1 contains gdbm-1.5 (which dates back to 1991). |
| 53 |
*/ |
| 54 |
#ifndef GDBM_FAST |
| 55 |
#define gdbm_exists(db,key) not_here("gdbm_exists") |
| 56 |
#define gdbm_sync(db) (void) not_here("gdbm_sync") |
| 57 |
#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt") |
| 58 |
#endif |
| 59 |
|
| 60 |
#include "const-c.inc" |
| 61 |
|
| 62 |
MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ |
| 63 |
|
| 64 |
INCLUDE: const-xs.inc |
| 65 |
|
| 66 |
GDBM_File |
| 67 |
gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak) |
| 68 |
char * dbtype |
| 69 |
char * name |
| 70 |
int read_write |
| 71 |
int mode |
| 72 |
FATALFUNC fatal_func |
| 73 |
CODE: |
| 74 |
{ |
| 75 |
GDBM_FILE dbp ; |
| 76 |
|
| 77 |
RETVAL = NULL ; |
| 78 |
if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) { |
| 79 |
RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ; |
| 80 |
Zero(RETVAL, 1, GDBM_File_type) ; |
| 81 |
RETVAL->dbp = dbp ; |
| 82 |
} |
| 83 |
|
| 84 |
} |
| 85 |
OUTPUT: |
| 86 |
RETVAL |
| 87 |
|
| 88 |
|
| 89 |
#define gdbm_close(db) gdbm_close(db->dbp) |
| 90 |
void |
| 91 |
gdbm_close(db) |
| 92 |
GDBM_File db |
| 93 |
CLEANUP: |
| 94 |
|
| 95 |
void |
| 96 |
gdbm_DESTROY(db) |
| 97 |
GDBM_File db |
| 98 |
CODE: |
| 99 |
gdbm_close(db); |
| 100 |
safefree(db); |
| 101 |
|
| 102 |
#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key) |
| 103 |
datum_value |
| 104 |
gdbm_FETCH(db, key) |
| 105 |
GDBM_File db |
| 106 |
datum_key_copy key |
| 107 |
|
| 108 |
#define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags) |
| 109 |
int |
| 110 |
gdbm_STORE(db, key, value, flags = GDBM_REPLACE) |
| 111 |
GDBM_File db |
| 112 |
datum_key key |
| 113 |
datum_value value |
| 114 |
int flags |
| 115 |
CLEANUP: |
| 116 |
if (RETVAL) { |
| 117 |
if (RETVAL < 0 && errno == EPERM) |
| 118 |
croak("No write permission to gdbm file"); |
| 119 |
croak("gdbm store returned %d, errno %d, key \"%.*s\"", |
| 120 |
RETVAL,errno,key.dsize,key.dptr); |
| 121 |
} |
| 122 |
|
| 123 |
#define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key) |
| 124 |
int |
| 125 |
gdbm_DELETE(db, key) |
| 126 |
GDBM_File db |
| 127 |
datum_key key |
| 128 |
|
| 129 |
#define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp) |
| 130 |
datum_key |
| 131 |
gdbm_FIRSTKEY(db) |
| 132 |
GDBM_File db |
| 133 |
|
| 134 |
#define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key) |
| 135 |
datum_key |
| 136 |
gdbm_NEXTKEY(db, key) |
| 137 |
GDBM_File db |
| 138 |
datum_key key |
| 139 |
|
| 140 |
#define gdbm_reorganize(db) gdbm_reorganize(db->dbp) |
| 141 |
int |
| 142 |
gdbm_reorganize(db) |
| 143 |
GDBM_File db |
| 144 |
|
| 145 |
|
| 146 |
#define gdbm_sync(db) gdbm_sync(db->dbp) |
| 147 |
void |
| 148 |
gdbm_sync(db) |
| 149 |
GDBM_File db |
| 150 |
|
| 151 |
#define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key) |
| 152 |
int |
| 153 |
gdbm_EXISTS(db, key) |
| 154 |
GDBM_File db |
| 155 |
datum_key key |
| 156 |
|
| 157 |
#define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen) |
| 158 |
int |
| 159 |
gdbm_setopt (db, optflag, optval, optlen) |
| 160 |
GDBM_File db |
| 161 |
int optflag |
| 162 |
int &optval |
| 163 |
int optlen |
| 164 |
|
| 165 |
|
| 166 |
SV * |
| 167 |
filter_fetch_key(db, code) |
| 168 |
GDBM_File db |
| 169 |
SV * code |
| 170 |
SV * RETVAL = &PL_sv_undef ; |
| 171 |
CODE: |
| 172 |
DBM_setFilter(db->filter_fetch_key, code) ; |
| 173 |
|
| 174 |
SV * |
| 175 |
filter_store_key(db, code) |
| 176 |
GDBM_File db |
| 177 |
SV * code |
| 178 |
SV * RETVAL = &PL_sv_undef ; |
| 179 |
CODE: |
| 180 |
DBM_setFilter(db->filter_store_key, code) ; |
| 181 |
|
| 182 |
SV * |
| 183 |
filter_fetch_value(db, code) |
| 184 |
GDBM_File db |
| 185 |
SV * code |
| 186 |
SV * RETVAL = &PL_sv_undef ; |
| 187 |
CODE: |
| 188 |
DBM_setFilter(db->filter_fetch_value, code) ; |
| 189 |
|
| 190 |
SV * |
| 191 |
filter_store_value(db, code) |
| 192 |
GDBM_File db |
| 193 |
SV * code |
| 194 |
SV * RETVAL = &PL_sv_undef ; |
| 195 |
CODE: |
| 196 |
DBM_setFilter(db->filter_store_value, code) ; |
| 197 |
|
