1#define PERL_NO_GET_CONTEXT 2 3#include "EXTERN.h" 4#include "perl.h" 5#include "XSUB.h" 6#undef NDBM_HEADER_USES_PROTOTYPES 7#if defined(I_GDBM_NDBM) 8# ifdef GDBM_NDBM_H_USES_PROTOTYPES 9# define NDBM_HEADER_USES_PROTOTYPES 10START_EXTERN_C 11# endif 12# include <gdbm-ndbm.h> /* Debian compatibility version */ 13#elif defined(I_GDBMNDBM) 14# ifdef GDBMNDBM_H_USES_PROTOTYPES 15# define NDBM_HEADER_USES_PROTOTYPES 16START_EXTERN_C 17# endif 18# include <gdbm/ndbm.h> /* RedHat compatibility version */ 19#elif defined(I_NDBM) 20# ifdef NDBM_H_USES_PROTOTYPES 21# define NDBM_HEADER_USES_PROTOTYPES 22START_EXTERN_C 23# endif 24# include <ndbm.h> 25#endif 26#ifdef NDBM_HEADER_USES_PROTOTYPES 27END_EXTERN_C 28#endif 29 30#define fetch_key 0 31#define store_key 1 32#define fetch_value 2 33#define store_value 3 34 35typedef struct { 36 DBM * dbp ; 37 SV * filter[4]; 38 int filtering ; 39 } NDBM_File_type; 40 41typedef NDBM_File_type * NDBM_File ; 42typedef datum datum_key ; 43typedef datum datum_value ; 44 45 46#if defined(__cplusplus) && !defined(NDBM_HEADER_USES_PROTOTYPES) 47/* gdbm's header file used for compatibility with gdbm */ 48/* isn't compatible to C++ syntax, so we need these */ 49/* declarations to make everyone happy. */ 50EXTERN_C DBM *dbm_open(const char *, int, mode_t); 51EXTERN_C void dbm_close(DBM *); 52EXTERN_C datum dbm_fetch(DBM *, datum); 53EXTERN_C int dbm_store(DBM *, datum, datum, int); 54EXTERN_C int dbm_delete(DBM *, datum); 55EXTERN_C datum dbm_firstkey(DBM *); 56EXTERN_C datum dbm_nextkey(DBM *); 57#endif 58 59MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = ndbm_ 60 61NDBM_File 62ndbm_TIEHASH(dbtype, filename, flags, mode) 63 char * dbtype 64 char * filename 65 int flags 66 int mode 67 CODE: 68 { 69 DBM * dbp ; 70 71 RETVAL = NULL ; 72 if ((dbp = dbm_open(filename, flags, mode))) { 73 RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type)); 74 RETVAL->dbp = dbp ; 75 } 76 77 } 78 OUTPUT: 79 RETVAL 80 81void 82ndbm_DESTROY(db) 83 NDBM_File db 84 PREINIT: 85 int i = store_value; 86 CODE: 87 dbm_close(db->dbp); 88 do { 89 if (db->filter[i]) 90 SvREFCNT_dec(db->filter[i]); 91 } while (i-- > 0); 92 safefree(db); 93 94#define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key) 95datum_value 96ndbm_FETCH(db, key) 97 NDBM_File db 98 datum_key key 99 100#define ndbm_EXISTS(db,key) dbm_fetch(db->dbp,key).dptr 101bool 102ndbm_EXISTS(db, key) 103 NDBM_File db 104 datum_key key 105 106#define ndbm_STORE(db,key,value,flags) dbm_store(db->dbp,key,value,flags) 107int 108ndbm_STORE(db, key, value, flags = DBM_REPLACE) 109 NDBM_File db 110 datum_key key 111 datum_value value 112 int flags 113 CLEANUP: 114 if (RETVAL) { 115 if (RETVAL < 0 && errno == EPERM) 116 croak("No write permission to ndbm file"); 117 croak("ndbm store returned %d, errno %d, key \"%s\"", 118 RETVAL, errno, (const char *)key.dptr); 119 dbm_clearerr(db->dbp); 120 } 121 122#define ndbm_DELETE(db,key) dbm_delete(db->dbp,key) 123int 124ndbm_DELETE(db, key) 125 NDBM_File db 126 datum_key key 127 128#define ndbm_FIRSTKEY(db) dbm_firstkey(db->dbp) 129datum_key 130ndbm_FIRSTKEY(db) 131 NDBM_File db 132 133#define ndbm_NEXTKEY(db,key) dbm_nextkey(db->dbp) 134datum_key 135ndbm_NEXTKEY(db, key) 136 NDBM_File db 137 datum_key key = NO_INIT 138 CLEANUP: 139 PERL_UNUSED_VAR(key); 140 141#define ndbm_error(db) dbm_error(db->dbp) 142int 143ndbm_error(db) 144 NDBM_File db 145 CLEANUP: 146 PERL_UNUSED_VAR(db); 147 148#define ndbm_clearerr(db) dbm_clearerr(db->dbp) 149void 150ndbm_clearerr(db) 151 NDBM_File db 152 CLEANUP: 153 PERL_UNUSED_VAR(db); 154 155 156SV * 157filter_fetch_key(db, code) 158 NDBM_File db 159 SV * code 160 SV * RETVAL = &PL_sv_undef ; 161 ALIAS: 162 NDBM_File::filter_fetch_key = fetch_key 163 NDBM_File::filter_store_key = store_key 164 NDBM_File::filter_fetch_value = fetch_value 165 NDBM_File::filter_store_value = store_value 166 CODE: 167 DBM_setFilter(db->filter[ix], code); 168