ext/GDBM_File/GDBM_File.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #include <gdbm.h>
   6 #include <fcntl.h>
   7
   8 typedef struct {
   9         GDBM_FILE       dbp ;
  10         SV *    filter_fetch_key ;
  11         SV *    filter_store_key ;
  12         SV *    filter_fetch_value ;
  13         SV *    filter_store_value ;
  14         int     filtering ;
  15         } GDBM_File_type;
  16
  17 typedef GDBM_File_type * GDBM_File ;
  18 typedef datum datum_key ;
  19 typedef datum datum_value ;
  20
  21 #define ckFilter(arg,type,name)                                 \
  22         if (db->type) {                                         \
  23             SV * save_defsv ;                                   \
  24             /* printf("filtering %s\n", name) ;*/               \
  25             if (db->filtering)                                  \
  26                 croak("recursion detected in %s", name) ;       \
  27             db->filtering = TRUE ;                              \
  28             save_defsv = newSVsv(DEFSV) ;                       \
  29             sv_setsv(DEFSV, arg) ;                              \
  30             PUSHMARK(sp) ;                                      \
  31             (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);  \
  32             sv_setsv(arg, DEFSV) ;                              \
  33             sv_setsv(DEFSV, save_defsv) ;                       \
  34             SvREFCNT_dec(save_defsv) ;                          \
  35             db->filtering = FALSE ;                             \
  36             /*printf("end of filtering %s\n", name) ;*/         \
  37         }
  38
  39
  40
  41 #define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
  42
  43 typedef void (*FATALFUNC)();
  44
  45 #ifndef GDBM_FAST
  46 static int
  47 not_here(char *s)
  48 {
  49     croak("GDBM_File::%s not implemented on this architecture", s);
  50     return -1;
  51 }
  52 #endif
  53
  54 /* GDBM allocates the datum with system malloc() and expects the user
  55  * to free() it.  So we either have to free() it immediately, or have
  56  * perl free() it when it deallocates the SV, depending on whether
  57  * perl uses malloc()/free() or not. */
  58 static void
  59 output_datum(pTHX_ SV *arg, char *str, int size)
  60 {
  61 #if (!defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))) && !defined(LEAKTEST)
  62         sv_usepvn(arg, str, size);
  63 #else
  64         sv_setpvn(arg, str, size);
  65         safesysfree(str);
  66 #endif
  67 }
  68
  69 /* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
  70    gdbm_exists, and gdbm_setopt functions.  Apparently Slackware
  71    (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
  72 */
  73 #ifndef GDBM_FAST
  74 #define gdbm_exists(db,key) not_here("gdbm_exists")
  75 #define gdbm_sync(db) (void) not_here("gdbm_sync")
  76 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
  77 #endif
  78
  79 #include "constants.c"
  80
  81 MODULE = GDBM_File      PACKAGE = GDBM_File     PREFIX = gdbm_
  82
  83 INCLUDE: constants.xs
  84
  85 GDBM_File
  86 gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
  87         char *          dbtype
  88         char *          name
  89         int             read_write
  90         int             mode
  91         FATALFUNC       fatal_func
  92         CODE:
  93         {
  94             GDBM_FILE   dbp ;
  95
  96             RETVAL = NULL ;
  97             if ((dbp =  gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) {
  98                 RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
  99                 Zero(RETVAL, 1, GDBM_File_type) ;
 100                 RETVAL->dbp = dbp ;
 101             }
 102
 103         }
 104         OUTPUT:
 105           RETVAL
 106
 107
 108 #define gdbm_close(db)                  gdbm_close(db->dbp)
 109 void
 110 gdbm_close(db)
 111         GDBM_File       db
 112         CLEANUP:
 113
 114 void
 115 gdbm_DESTROY(db)
 116         GDBM_File       db
 117         CODE:
 118         gdbm_close(db);
 119         safefree(db);
 120
 121 #define gdbm_FETCH(db,key)                      gdbm_fetch(db->dbp,key)
 122 datum_value
 123 gdbm_FETCH(db, key)
 124         GDBM_File       db
 125         datum_key       key
 126
 127 #define gdbm_STORE(db,key,value,flags)          gdbm_store(db->dbp,key,value,flags)
 128 int
 129 gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
 130         GDBM_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 gdbm file");
 138             croak("gdbm store returned %d, errno %d, key \"%.*s\"",
 139                         RETVAL,errno,key.dsize,key.dptr);
 140         }
 141
 142 #define gdbm_DELETE(db,key)                     gdbm_delete(db->dbp,key)
 143 int
 144 gdbm_DELETE(db, key)
 145         GDBM_File       db
 146         datum_key       key
 147
 148 #define gdbm_FIRSTKEY(db)                       gdbm_firstkey(db->dbp)
 149 datum_key
 150 gdbm_FIRSTKEY(db)
 151         GDBM_File       db
 152
 153 #define gdbm_NEXTKEY(db,key)                    gdbm_nextkey(db->dbp,key)
 154 datum_key
 155 gdbm_NEXTKEY(db, key)
 156         GDBM_File       db
 157         datum_key       key
 158
 159 #define gdbm_reorganize(db)                     gdbm_reorganize(db->dbp)
 160 int
 161 gdbm_reorganize(db)
 162         GDBM_File       db
 163
 164
 165 #define gdbm_sync(db)                           gdbm_sync(db->dbp)
 166 void
 167 gdbm_sync(db)
 168         GDBM_File       db
 169
 170 #define gdbm_EXISTS(db,key)                     gdbm_exists(db->dbp,key)
 171 int
 172 gdbm_EXISTS(db, key)
 173         GDBM_File       db
 174         datum_key       key
 175
 176 #define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
 177 int
 178 gdbm_setopt (db, optflag, optval, optlen)
 179         GDBM_File       db
 180         int             optflag
 181         int             &optval
 182         int             optlen
 183
 184
 185 #define setFilter(type)                                 \
 186         {                                               \
 187             if (db->type)                               \
 188                 RETVAL = sv_mortalcopy(db->type) ;      \
 189             ST(0) = RETVAL ;                            \
 190             if (db->type && (code == &PL_sv_undef)) {   \
 191                 SvREFCNT_dec(db->type) ;                \
 192                 db->type = NULL ;                       \
 193             }                                           \
 194             else if (code) {                            \
 195                 if (db->type)                           \
 196                     sv_setsv(db->type, code) ;          \
 197                 else                                    \
 198                     db->type = newSVsv(code) ;          \
 199             }                                           \
 200         }
 201
 202
 203
 204 SV *
 205 filter_fetch_key(db, code)
 206         GDBM_File       db
 207         SV *            code
 208         SV *            RETVAL = &PL_sv_undef ;
 209         CODE:
 210             setFilter(filter_fetch_key) ;
 211
 212 SV *
 213 filter_store_key(db, code)
 214         GDBM_File       db
 215         SV *            code
 216         SV *            RETVAL =  &PL_sv_undef ;
 217         CODE:
 218             setFilter(filter_store_key) ;
 219
 220 SV *
 221 filter_fetch_value(db, code)
 222         GDBM_File       db
 223         SV *            code
 224         SV *            RETVAL =  &PL_sv_undef ;
 225         CODE:
 226             setFilter(filter_fetch_value) ;
 227
 228 SV *
 229 filter_store_value(db, code)
 230         GDBM_File       db
 231         SV *            code
 232         SV *            RETVAL =  &PL_sv_undef ;
 233         CODE:
 234             setFilter(filter_store_value) ;
 235