ext/ODBM_File/ODBM_File.xs

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