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_value ;
  57
  58 #define ckFilter(arg,type,name)                                 \
  59         if (db->type) {                                         \
  60             SV * save_defsv ;                                   \
  61             /* printf("filtering %s\n", name) ;*/               \
  62             if (db->filtering)                                  \
  63                 croak("recursion detected in %s", name) ;       \
  64             db->filtering = TRUE ;                              \
  65             save_defsv = newSVsv(DEFSV) ;                       \
  66             sv_setsv(DEFSV, arg) ;                              \
  67             PUSHMARK(sp) ;                                      \
  68             (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);  \
  69             sv_setsv(arg, DEFSV) ;                              \
  70             sv_setsv(DEFSV, save_defsv) ;                       \
  71             SvREFCNT_dec(save_defsv) ;                          \
  72             db->filtering = FALSE ;                             \
  73             /*printf("end of filtering %s\n", name) ;*/         \
  74         }
  75
  76
  77 #define odbm_FETCH(db,key)                      fetch(key)
  78 #define odbm_STORE(db,key,value,flags)          store(key,value)
  79 #define odbm_DELETE(db,key)                     delete(key)
  80 #define odbm_FIRSTKEY(db)                       firstkey()
  81 #define odbm_NEXTKEY(db,key)                    nextkey(key)
  82
  83 static int dbmrefcnt;
  84
  85 #ifndef DBM_REPLACE
  86 #define DBM_REPLACE 0
  87 #endif
  88
  89 MODULE = ODBM_File      PACKAGE = ODBM_File     PREFIX = odbm_
  90
  91 ODBM_File
  92 odbm_TIEHASH(dbtype, filename, flags, mode)
  93         char *          dbtype
  94         char *          filename
  95         int             flags
  96         int             mode
  97         CODE:
  98         {
  99             char *tmpbuf;
 100             void * dbp ;
 101             if (dbmrefcnt++)
 102                 croak("Old dbm can only open one database");
 103             New(0, tmpbuf, strlen(filename) + 5, char);
 104             SAVEFREEPV(tmpbuf);
 105             sprintf(tmpbuf,"%s.dir",filename);
 106             if (stat(tmpbuf, &PL_statbuf) < 0) {
 107                 if (flags & O_CREAT) {
 108                     if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
 109                         croak("ODBM_File: Can't create %s", filename);
 110                     sprintf(tmpbuf,"%s.pag",filename);
 111                     if (close(creat(tmpbuf,mode)) < 0)
 112                         croak("ODBM_File: Can't create %s", filename);
 113                 }
 114                 else
 115                     croak("ODBM_FILE: Can't open %s", filename);
 116             }
 117             dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
 118             RETVAL = (ODBM_File)safemalloc(sizeof(ODBM_File_type)) ;
 119             Zero(RETVAL, 1, ODBM_File_type) ;
 120             RETVAL->dbp = dbp ;
 121             ST(0) = sv_mortalcopy(&PL_sv_undef);
 122             sv_setptrobj(ST(0), RETVAL, dbtype);
 123         }
 124
 125 void
 126 DESTROY(db)
 127         ODBM_File       db
 128         CODE:
 129         dbmrefcnt--;
 130         dbmclose();
 131         safefree(db);
 132
 133 datum_value
 134 odbm_FETCH(db, key)
 135         ODBM_File       db
 136         datum_key       key
 137
 138 int
 139 odbm_STORE(db, key, value, flags = DBM_REPLACE)
 140         ODBM_File       db
 141         datum_key       key
 142         datum_value     value
 143         int             flags
 144     CLEANUP:
 145         if (RETVAL) {
 146             if (RETVAL < 0 && errno == EPERM)
 147                 croak("No write permission to odbm file");
 148             croak("odbm store returned %d, errno %d, key \"%s\"",
 149                         RETVAL,errno,key.dptr);
 150         }
 151
 152 int
 153 odbm_DELETE(db, key)
 154         ODBM_File       db
 155         datum_key       key
 156
 157 datum_key
 158 odbm_FIRSTKEY(db)
 159         ODBM_File       db
 160
 161 datum_key
 162 odbm_NEXTKEY(db, key)
 163         ODBM_File       db
 164         datum_key       key
 165
 166
 167 #define setFilter(type)                                 \
 168         {                                               \
 169             if (db->type)                               \
 170                 RETVAL = sv_mortalcopy(db->type) ;      \
 171             ST(0) = RETVAL ;                            \
 172             if (db->type && (code == &PL_sv_undef)) {   \
 173                 SvREFCNT_dec(db->type) ;                \
 174                 db->type = Nullsv ;                     \
 175             }                                           \
 176             else if (code) {                            \
 177                 if (db->type)                           \
 178                     sv_setsv(db->type, code) ;          \
 179                 else                                    \
 180                     db->type = newSVsv(code) ;          \
 181             }                                           \
 182         }
 183
 184
 185
 186 SV *
 187 filter_fetch_key(db, code)
 188         ODBM_File       db
 189         SV *            code
 190         SV *            RETVAL = &PL_sv_undef ;
 191         CODE:
 192             setFilter(filter_fetch_key) ;
 193
 194 SV *
 195 filter_store_key(db, code)
 196         ODBM_File       db
 197         SV *            code
 198         SV *            RETVAL =  &PL_sv_undef ;
 199         CODE:
 200             setFilter(filter_store_key) ;
 201
 202 SV *
 203 filter_fetch_value(db, code)
 204         ODBM_File       db
 205         SV *            code
 206         SV *            RETVAL =  &PL_sv_undef ;
 207         CODE:
 208             setFilter(filter_fetch_value) ;
 209
 210 SV *
 211 filter_store_value(db, code)
 212         ODBM_File       db
 213         SV *            code
 214         SV *            RETVAL =  &PL_sv_undef ;
 215         CODE:
 216             setFilter(filter_store_value) ;
 217