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) && !defined(LEAKTEST))
  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         safefree(db);
 240
 241 #define gdbm_FETCH(db,key)                      gdbm_fetch(db->dbp,key)
 242 datum_value
 243 gdbm_FETCH(db, key)
 244         GDBM_File       db
 245         datum_key       key
 246
 247 #define gdbm_STORE(db,key,value,flags)          gdbm_store(db->dbp,key,value,flags)
 248 int
 249 gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
 250         GDBM_File       db
 251         datum_key       key
 252         datum_value     value
 253         int             flags
 254     CLEANUP:
 255         if (RETVAL) {
 256             if (RETVAL < 0 && errno == EPERM)
 257                 croak("No write permission to gdbm file");
 258             croak("gdbm store returned %d, errno %d, key \"%.*s\"",
 259                         RETVAL,errno,key.dsize,key.dptr);
 260         }
 261
 262 #define gdbm_DELETE(db,key)                     gdbm_delete(db->dbp,key)
 263 int
 264 gdbm_DELETE(db, key)
 265         GDBM_File       db
 266         datum_key       key
 267
 268 #define gdbm_FIRSTKEY(db)                       gdbm_firstkey(db->dbp)
 269 datum_key
 270 gdbm_FIRSTKEY(db)
 271         GDBM_File       db
 272
 273 #define gdbm_NEXTKEY(db,key)                    gdbm_nextkey(db->dbp,key)
 274 datum_key
 275 gdbm_NEXTKEY(db, key)
 276         GDBM_File       db
 277         datum_key       key
 278
 279 #define gdbm_reorganize(db)                     gdbm_reorganize(db->dbp)
 280 int
 281 gdbm_reorganize(db)
 282         GDBM_File       db
 283
 284
 285 #define gdbm_sync(db)                           gdbm_sync(db->dbp)
 286 void
 287 gdbm_sync(db)
 288         GDBM_File       db
 289
 290 #define gdbm_EXISTS(db,key)                     gdbm_exists(db->dbp,key)
 291 int
 292 gdbm_EXISTS(db, key)
 293         GDBM_File       db
 294         datum_key       key
 295
 296 #define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
 297 int
 298 gdbm_setopt (db, optflag, optval, optlen)
 299         GDBM_File       db
 300         int             optflag
 301         int             &optval
 302         int             optlen
 303
 304
 305 #define setFilter(type)                                 \
 306         {                                               \
 307             if (db->type)                               \
 308                 RETVAL = sv_mortalcopy(db->type) ;      \
 309             ST(0) = RETVAL ;                            \
 310             if (db->type && (code == &PL_sv_undef)) {   \
 311                 SvREFCNT_dec(db->type) ;                \
 312                 db->type = NULL ;                       \
 313             }                                           \
 314             else if (code) {                            \
 315                 if (db->type)                           \
 316                     sv_setsv(db->type, code) ;          \
 317                 else                                    \
 318                     db->type = newSVsv(code) ;          \
 319             }                                           \
 320         }
 321
 322
 323
 324 SV *
 325 filter_fetch_key(db, code)
 326         GDBM_File       db
 327         SV *            code
 328         SV *            RETVAL = &PL_sv_undef ;
 329         CODE:
 330             setFilter(filter_fetch_key) ;
 331
 332 SV *
 333 filter_store_key(db, code)
 334         GDBM_File       db
 335         SV *            code
 336         SV *            RETVAL =  &PL_sv_undef ;
 337         CODE:
 338             setFilter(filter_store_key) ;
 339
 340 SV *
 341 filter_fetch_value(db, code)
 342         GDBM_File       db
 343         SV *            code
 344         SV *            RETVAL =  &PL_sv_undef ;
 345         CODE:
 346             setFilter(filter_fetch_value) ;
 347
 348 SV *
 349 filter_store_value(db, code)
 350         GDBM_File       db
 351         SV *            code
 352         SV *            RETVAL =  &PL_sv_undef ;
 353         CODE:
 354             setFilter(filter_store_value) ;
 355