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 static int
  46 not_here(char *s)
  47 {
  48     croak("GDBM_File::%s not implemented on this architecture", s);
  49     return -1;
  50 }
  51
  52 /* GDBM allocates the datum with system malloc() and expects the user
  53  * to free() it.  So we either have to free() it immediately, or have
  54  * perl free() it when it deallocates the SV, depending on whether
  55  * perl uses malloc()/free() or not. */
  56 static void
  57 output_datum(pTHX_ SV *arg, char *str, int size)
  58 {
  59 #if !defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))
  60         sv_usepvn(arg, str, size);
  61 #else
  62         sv_setpvn(arg, str, size);
  63         safesysfree(str);
  64 #endif
  65 }
  66
  67 /* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
  68    gdbm_exists, and gdbm_setopt functions.  Apparently Slackware
  69    (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
  70 */
  71 #ifndef GDBM_FAST
  72 #define gdbm_exists(db,key) not_here("gdbm_exists")
  73 #define gdbm_sync(db) (void) not_here("gdbm_sync")
  74 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
  75 #endif
  76
  77 static double
  78 constant(char *name, int arg)
  79 {
  80     errno = 0;
  81     switch (*name) {
  82     case 'A':
  83         break;
  84     case 'B':
  85         break;
  86     case 'C':
  87         break;
  88     case 'D':
  89         break;
  90     case 'E':
  91         break;
  92     case 'F':
  93         break;
  94     case 'G':
  95         if (strEQ(name, "GDBM_CACHESIZE"))
  96 #ifdef GDBM_CACHESIZE
  97             return GDBM_CACHESIZE;
  98 #else
  99             goto not_there;
 100 #endif
 101         if (strEQ(name, "GDBM_FAST"))
 102 #ifdef GDBM_FAST
 103             return GDBM_FAST;
 104 #else
 105             goto not_there;
 106 #endif
 107         if (strEQ(name, "GDBM_FASTMODE"))
 108 #ifdef GDBM_FASTMODE
 109             return GDBM_FASTMODE;
 110 #else
 111             goto not_there;
 112 #endif
 113         if (strEQ(name, "GDBM_INSERT"))
 114 #ifdef GDBM_INSERT
 115             return GDBM_INSERT;
 116 #else
 117             goto not_there;
 118 #endif
 119         if (strEQ(name, "GDBM_NEWDB"))
 120 #ifdef GDBM_NEWDB
 121             return GDBM_NEWDB;
 122 #else
 123             goto not_there;
 124 #endif
 125         if (strEQ(name, "GDBM_READER"))
 126 #ifdef GDBM_READER
 127             return GDBM_READER;
 128 #else
 129             goto not_there;
 130 #endif
 131         if (strEQ(name, "GDBM_REPLACE"))
 132 #ifdef GDBM_REPLACE
 133             return GDBM_REPLACE;
 134 #else
 135             goto not_there;
 136 #endif
 137         if (strEQ(name, "GDBM_WRCREAT"))
 138 #ifdef GDBM_WRCREAT
 139             return GDBM_WRCREAT;
 140 #else
 141             goto not_there;
 142 #endif
 143         if (strEQ(name, "GDBM_WRITER"))
 144 #ifdef GDBM_WRITER
 145             return GDBM_WRITER;
 146 #else
 147             goto not_there;
 148 #endif
 149         break;
 150     case 'H':
 151         break;
 152     case 'I':
 153         break;
 154     case 'J':
 155         break;
 156     case 'K':
 157         break;
 158     case 'L':
 159         break;
 160     case 'M':
 161         break;
 162     case 'N':
 163         break;
 164     case 'O':
 165         break;
 166     case 'P':
 167         break;
 168     case 'Q':
 169         break;
 170     case 'R':
 171         break;
 172     case 'S':
 173         break;
 174     case 'T':
 175         break;
 176     case 'U':
 177         break;
 178     case 'V':
 179         break;
 180     case 'W':
 181         break;
 182     case 'X':
 183         break;
 184     case 'Y':
 185         break;
 186     case 'Z':
 187         break;
 188     }
 189     errno = EINVAL;
 190     return 0;
 191
 192 not_there:
 193     errno = ENOENT;
 194     return 0;
 195 }
 196
 197 MODULE = GDBM_File      PACKAGE = GDBM_File     PREFIX = gdbm_
 198
 199 double
 200 constant(name,arg)
 201         char *          name
 202         int             arg
 203
 204
 205 GDBM_File
 206 gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
 207         char *          dbtype
 208         char *          name
 209         int             read_write
 210         int             mode
 211         FATALFUNC       fatal_func
 212         CODE:
 213         {
 214             GDBM_FILE   dbp ;
 215
 216             RETVAL = NULL ;
 217             if (dbp =  gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)) {
 218                 RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
 219                 Zero(RETVAL, 1, GDBM_File_type) ;
 220                 RETVAL->dbp = dbp ;
 221             }
 222
 223         }
 224         OUTPUT:
 225           RETVAL
 226
 227
 228 #define gdbm_close(db)                  gdbm_close(db->dbp)
 229 void
 230 gdbm_close(db)
 231         GDBM_File       db
 232         CLEANUP:
 233
 234 void
 235 gdbm_DESTROY(db)
 236         GDBM_File       db
 237         CODE:
 238         gdbm_close(db);
 239
 240 #define gdbm_FETCH(db,key)                      gdbm_fetch(db->dbp,key)
 241 datum_value
 242 gdbm_FETCH(db, key)
 243         GDBM_File       db
 244         datum_key       key
 245
 246 #define gdbm_STORE(db,key,value,flags)          gdbm_store(db->dbp,key,value,flags)
 247 int
 248 gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
 249         GDBM_File       db
 250         datum_key       key
 251         datum_value     value
 252         int             flags
 253     CLEANUP:
 254         if (RETVAL) {
 255             if (RETVAL < 0 && errno == EPERM)
 256                 croak("No write permission to gdbm file");
 257             croak("gdbm store returned %d, errno %d, key \"%.*s\"",
 258                         RETVAL,errno,key.dsize,key.dptr);
 259         }
 260
 261 #define gdbm_DELETE(db,key)                     gdbm_delete(db->dbp,key)
 262 int
 263 gdbm_DELETE(db, key)
 264         GDBM_File       db
 265         datum_key       key
 266
 267 #define gdbm_FIRSTKEY(db)                       gdbm_firstkey(db->dbp)
 268 datum_key
 269 gdbm_FIRSTKEY(db)
 270         GDBM_File       db
 271
 272 #define gdbm_NEXTKEY(db,key)                    gdbm_nextkey(db->dbp,key)
 273 datum_key
 274 gdbm_NEXTKEY(db, key)
 275         GDBM_File       db
 276         datum_key       key
 277
 278 #define gdbm_reorganize(db)                     gdbm_reorganize(db->dbp)
 279 int
 280 gdbm_reorganize(db)
 281         GDBM_File       db
 282
 283
 284 #define gdbm_sync(db)                           gdbm_sync(db->dbp)
 285 void
 286 gdbm_sync(db)
 287         GDBM_File       db
 288
 289 #define gdbm_EXISTS(db,key)                     gdbm_exists(db->dbp,key)
 290 int
 291 gdbm_EXISTS(db, key)
 292         GDBM_File       db
 293         datum_key       key
 294
 295 #define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
 296 int
 297 gdbm_setopt (db, optflag, optval, optlen)
 298         GDBM_File       db
 299         int             optflag
 300         int             &optval
 301         int             optlen
 302
 303
 304 #define setFilter(type)                                 \
 305         {                                               \
 306             if (db->type)                               \
 307                 RETVAL = sv_mortalcopy(db->type) ;      \
 308             ST(0) = RETVAL ;                            \
 309             if (db->type && (code == &PL_sv_undef)) {   \
 310                 SvREFCNT_dec(db->type) ;                \
 311                 db->type = NULL ;                       \
 312             }                                           \
 313             else if (code) {                            \
 314                 if (db->type)                           \
 315                     sv_setsv(db->type, code) ;          \
 316                 else                                    \
 317                     db->type = newSVsv(code) ;          \
 318             }                                           \
 319         }
 320
 321
 322
 323 SV *
 324 filter_fetch_key(db, code)
 325         GDBM_File       db
 326         SV *            code
 327         SV *            RETVAL = &PL_sv_undef ;
 328         CODE:
 329             setFilter(filter_fetch_key) ;
 330
 331 SV *
 332 filter_store_key(db, code)
 333         GDBM_File       db
 334         SV *            code
 335         SV *            RETVAL =  &PL_sv_undef ;
 336         CODE:
 337             setFilter(filter_store_key) ;
 338
 339 SV *
 340 filter_fetch_value(db, code)
 341         GDBM_File       db
 342         SV *            code
 343         SV *            RETVAL =  &PL_sv_undef ;
 344         CODE:
 345             setFilter(filter_fetch_value) ;
 346
 347 SV *
 348 filter_store_value(db, code)
 349         GDBM_File       db
 350         SV *            code
 351         SV *            RETVAL =  &PL_sv_undef ;
 352         CODE:
 353             setFilter(filter_store_value) ;
 354