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