ext/GDBM_File/GDBM_File.xs

   1 #define PERL_NO_GET_CONTEXT
   2
   3 #include "EXTERN.h"
   4 #include "perl.h"
   5 #include "XSUB.h"
   6
   7 #include <gdbm.h>
   8 #include <fcntl.h>
   9
  10 #define fetch_key 0
  11 #define store_key 1
  12 #define fetch_value 2
  13 #define store_value 3
  14
  15 typedef struct {
  16         GDBM_FILE       dbp ;
  17         SV *    filter[4];
  18         int     filtering ;
  19         } GDBM_File_type;
  20
  21 typedef GDBM_File_type * GDBM_File ;
  22 typedef datum datum_key ;
  23 typedef datum datum_value ;
  24 typedef datum datum_key_copy;
  25
  26 #if defined(GDBM_VERSION_MAJOR) && defined(GDBM_VERSION_MINOR) \
  27     && GDBM_VERSION_MAJOR > 1 || \
  28     (GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9)
  29 typedef void (*FATALFUNC)(const char *);
  30 #else
  31 typedef void (*FATALFUNC)();
  32 #endif
  33
  34 #ifndef GDBM_FAST
  35 static int
  36 not_here(char *s)
  37 {
  38     croak("GDBM_File::%s not implemented on this architecture", s);
  39     return -1;
  40 }
  41 #endif
  42
  43 /* GDBM allocates the datum with system malloc() and expects the user
  44  * to free() it.  So we either have to free() it immediately, or have
  45  * perl free() it when it deallocates the SV, depending on whether
  46  * perl uses malloc()/free() or not. */
  47 static void
  48 output_datum(pTHX_ SV *arg, char *str, int size)
  49 {
  50         sv_setpvn(arg, str, size);
  51 #       undef free
  52         free(str);
  53 }
  54
  55 /* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
  56    gdbm_exists, and gdbm_setopt functions.  Apparently Slackware
  57    (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
  58 */
  59 #ifndef GDBM_FAST
  60 #define gdbm_exists(db,key) not_here("gdbm_exists")
  61 #define gdbm_sync(db) (void) not_here("gdbm_sync")
  62 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
  63 #endif
  64
  65 static void
  66 croak_string(const char *message) {
  67     Perl_croak_nocontext("%s", message);
  68 }
  69
  70 #include "const-c.inc"
  71
  72 MODULE = GDBM_File      PACKAGE = GDBM_File     PREFIX = gdbm_
  73
  74 INCLUDE: const-xs.inc
  75
  76 GDBM_File
  77 gdbm_TIEHASH(dbtype, name, read_write, mode)
  78         char *          dbtype
  79         char *          name
  80         int             read_write
  81         int             mode
  82         PREINIT:
  83         GDBM_FILE dbp;
  84         CODE:
  85         dbp = gdbm_open(name, 0, read_write, mode, (FATALFUNC)croak_string);
  86         if (!dbp && gdbm_errno == GDBM_BLOCK_SIZE_ERROR) {
  87             /*
  88              * By specifying a block size of 0 above, we asked gdbm to
  89              * default to the filesystem's block size.  That's usually the
  90              * right size to choose.  But some versions of gdbm require
  91              * a power-of-two block size, and some unusual filesystems
  92              * or devices have a non-power-of-two size that cause this
  93              * defaulting to fail.  In that case, force an acceptable
  94              * block size.
  95              */
  96             dbp = gdbm_open(name, 4096, read_write, mode,
  97                     (FATALFUNC)croak_string);
  98         }
  99         if (dbp) {
 100             RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type));
 101             RETVAL->dbp = dbp;
 102         } else {
 103             RETVAL = NULL;
 104         }
 105         OUTPUT:
 106           RETVAL
 107
 108
 109 #define gdbm_close(db)                  gdbm_close(db->dbp)
 110 void
 111 gdbm_close(db)
 112         GDBM_File       db
 113         CLEANUP:
 114
 115 void
 116 gdbm_DESTROY(db)
 117         GDBM_File       db
 118         PREINIT:
 119         int i = store_value;
 120         CODE:
 121         gdbm_close(db);
 122         do {
 123             if (db->filter[i])
 124                 SvREFCNT_dec(db->filter[i]);
 125         } while (i-- > 0);
 126         safefree(db);
 127
 128 #define gdbm_FETCH(db,key)                      gdbm_fetch(db->dbp,key)
 129 datum_value
 130 gdbm_FETCH(db, key)
 131         GDBM_File       db
 132         datum_key_copy  key
 133
 134 #define gdbm_STORE(db,key,value,flags)          gdbm_store(db->dbp,key,value,flags)
 135 int
 136 gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
 137         GDBM_File       db
 138         datum_key       key
 139         datum_value     value
 140         int             flags
 141     CLEANUP:
 142         if (RETVAL) {
 143             if (RETVAL < 0 && errno == EPERM)
 144                 croak("No write permission to gdbm file");
 145             croak("gdbm store returned %d, errno %d, key \"%.*s\"",
 146                         RETVAL,errno,key.dsize,key.dptr);
 147         }
 148
 149 #define gdbm_DELETE(db,key)                     gdbm_delete(db->dbp,key)
 150 int
 151 gdbm_DELETE(db, key)
 152         GDBM_File       db
 153         datum_key       key
 154
 155 #define gdbm_FIRSTKEY(db)                       gdbm_firstkey(db->dbp)
 156 datum_key
 157 gdbm_FIRSTKEY(db)
 158         GDBM_File       db
 159
 160 #define gdbm_NEXTKEY(db,key)                    gdbm_nextkey(db->dbp,key)
 161 datum_key
 162 gdbm_NEXTKEY(db, key)
 163         GDBM_File       db
 164         datum_key       key
 165
 166 #define gdbm_reorganize(db)                     gdbm_reorganize(db->dbp)
 167 int
 168 gdbm_reorganize(db)
 169         GDBM_File       db
 170
 171
 172 #define gdbm_sync(db)                           gdbm_sync(db->dbp)
 173 void
 174 gdbm_sync(db)
 175         GDBM_File       db
 176
 177 #define gdbm_EXISTS(db,key)                     gdbm_exists(db->dbp,key)
 178 int
 179 gdbm_EXISTS(db, key)
 180         GDBM_File       db
 181         datum_key       key
 182
 183 #define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
 184 int
 185 gdbm_setopt (db, optflag, optval, optlen)
 186         GDBM_File       db
 187         int             optflag
 188         int             &optval
 189         int             optlen
 190
 191
 192 SV *
 193 filter_fetch_key(db, code)
 194         GDBM_File       db
 195         SV *            code
 196         SV *            RETVAL = &PL_sv_undef ;
 197         ALIAS:
 198         GDBM_File::filter_fetch_key = fetch_key
 199         GDBM_File::filter_store_key = store_key
 200         GDBM_File::filter_fetch_value = fetch_value
 201         GDBM_File::filter_store_value = store_value
 202         CODE:
 203             DBM_setFilter(db->filter[ix], code);