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