ext/ODBM_File/ODBM_File.xs

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