ext/SDBM_File/SDBM_File.xs

   1 #define PERL_NO_GET_CONTEXT
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5 #include "sdbm/sdbm.h"
   6
   7 typedef struct {
   8         DBM *   dbp ;
   9         SV *    filter_fetch_key ;
  10         SV *    filter_store_key ;
  11         SV *    filter_fetch_value ;
  12         SV *    filter_store_value ;
  13         int     filtering ;
  14         } SDBM_File_type;
  15
  16 typedef SDBM_File_type * SDBM_File ;
  17 typedef datum datum_key ;
  18 typedef datum datum_value ;
  19
  20 #define ckFilter(arg,type,name)                                 \
  21         if (db->type) {                                         \
  22             SV * save_defsv ;                                   \
  23             /* printf("filtering %s\n", name) ;*/               \
  24             if (db->filtering)                                  \
  25                 croak("recursion detected in %s", name) ;       \
  26             db->filtering = TRUE ;                              \
  27             save_defsv = newSVsv(DEFSV) ;                       \
  28             sv_setsv(DEFSV, arg) ;                              \
  29             PUSHMARK(sp) ;                                      \
  30             (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);  \
  31             sv_setsv(arg, DEFSV) ;                              \
  32             sv_setsv(DEFSV, save_defsv) ;                               \
  33             SvREFCNT_dec(save_defsv) ;                          \
  34             db->filtering = FALSE ;                             \
  35             /*printf("end of filtering %s\n", name) ;*/         \
  36         }
  37
  38 #define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
  39 #define sdbm_FETCH(db,key)                      sdbm_fetch(db->dbp,key)
  40 #define sdbm_STORE(db,key,value,flags)          sdbm_store(db->dbp,key,value,flags)
  41 #define sdbm_DELETE(db,key)                     sdbm_delete(db->dbp,key)
  42 #define sdbm_EXISTS(db,key)                     sdbm_exists(db->dbp,key)
  43 #define sdbm_FIRSTKEY(db)                       sdbm_firstkey(db->dbp)
  44 #define sdbm_NEXTKEY(db,key)                    sdbm_nextkey(db->dbp)
  45
  46
  47 MODULE = SDBM_File      PACKAGE = SDBM_File     PREFIX = sdbm_
  48
  49 SDBM_File
  50 sdbm_TIEHASH(dbtype, filename, flags, mode)
  51         char *          dbtype
  52         char *          filename
  53         int             flags
  54         int             mode
  55         CODE:
  56         {
  57             DBM *       dbp ;
  58
  59             RETVAL = NULL ;
  60             if ((dbp = sdbm_open(filename,flags,mode))) {
  61                 RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
  62                 Zero(RETVAL, 1, SDBM_File_type) ;
  63                 RETVAL->dbp = dbp ;
  64             }
  65
  66         }
  67         OUTPUT:
  68           RETVAL
  69
  70 void
  71 sdbm_DESTROY(db)
  72         SDBM_File       db
  73         CODE:
  74           sdbm_close(db->dbp);
  75           if (db->filter_fetch_key)
  76             SvREFCNT_dec(db->filter_fetch_key) ;
  77           if (db->filter_store_key)
  78             SvREFCNT_dec(db->filter_store_key) ;
  79           if (db->filter_fetch_value)
  80             SvREFCNT_dec(db->filter_fetch_value) ;
  81           if (db->filter_store_value)
  82             SvREFCNT_dec(db->filter_store_value) ;
  83           safefree(db) ;
  84
  85 datum_value
  86 sdbm_FETCH(db, key)
  87         SDBM_File       db
  88         datum_key       key
  89
  90 int
  91 sdbm_STORE(db, key, value, flags = DBM_REPLACE)
  92         SDBM_File       db
  93         datum_key       key
  94         datum_value     value
  95         int             flags
  96     CLEANUP:
  97         if (RETVAL) {
  98             if (RETVAL < 0 && errno == EPERM)
  99                 croak("No write permission to sdbm file");
 100             croak("sdbm store returned %d, errno %d, key \"%s\"",
 101                         RETVAL,errno,key.dptr);
 102             sdbm_clearerr(db->dbp);
 103         }
 104
 105 int
 106 sdbm_DELETE(db, key)
 107         SDBM_File       db
 108         datum_key       key
 109
 110 int
 111 sdbm_EXISTS(db,key)
 112         SDBM_File       db
 113         datum_key       key
 114
 115 datum_key
 116 sdbm_FIRSTKEY(db)
 117         SDBM_File       db
 118
 119 datum_key
 120 sdbm_NEXTKEY(db, key)
 121         SDBM_File       db
 122         datum_key       key
 123
 124 int
 125 sdbm_error(db)
 126         SDBM_File       db
 127         CODE:
 128         RETVAL = sdbm_error(db->dbp) ;
 129         OUTPUT:
 130           RETVAL
 131
 132 int
 133 sdbm_clearerr(db)
 134         SDBM_File       db
 135         CODE:
 136         RETVAL = sdbm_clearerr(db->dbp) ;
 137         OUTPUT:
 138           RETVAL
 139
 140
 141 #define setFilter(type)                                 \
 142         {                                               \
 143             if (db->type)                               \
 144                 RETVAL = sv_mortalcopy(db->type) ;      \
 145             ST(0) = RETVAL ;                            \
 146             if (db->type && (code == &PL_sv_undef)) {   \
 147                 SvREFCNT_dec(db->type) ;                \
 148                 db->type = NULL ;                       \
 149             }                                           \
 150             else if (code) {                            \
 151                 if (db->type)                           \
 152                     sv_setsv(db->type, code) ;          \
 153                 else                                    \
 154                     db->type = newSVsv(code) ;          \
 155             }                                           \
 156         }
 157
 158
 159
 160 SV *
 161 filter_fetch_key(db, code)
 162         SDBM_File       db
 163         SV *            code
 164         SV *            RETVAL = &PL_sv_undef ;
 165         CODE:
 166             setFilter(filter_fetch_key) ;
 167
 168 SV *
 169 filter_store_key(db, code)
 170         SDBM_File       db
 171         SV *            code
 172         SV *            RETVAL =  &PL_sv_undef ;
 173         CODE:
 174             setFilter(filter_store_key) ;
 175
 176 SV *
 177 filter_fetch_value(db, code)
 178         SDBM_File       db
 179         SV *            code
 180         SV *            RETVAL =  &PL_sv_undef ;
 181         CODE:
 182             setFilter(filter_fetch_value) ;
 183
 184 SV *
 185 filter_store_value(db, code)
 186         SDBM_File       db
 187         SV *            code
 188         SV *            RETVAL =  &PL_sv_undef ;
 189         CODE:
 190             setFilter(filter_store_value) ;
 191