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