contrib/perl5/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 GDBM_FILE GDBM_File;
   9
  10 #define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
  11 #define gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func) \
  12         gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)
  13
  14 #define gdbm_FETCH(db,key)                      gdbm_fetch(db,key)
  15 #define gdbm_STORE(db,key,value,flags)          gdbm_store(db,key,value,flags)
  16 #define gdbm_DELETE(db,key)                     gdbm_delete(db,key)
  17 #define gdbm_FIRSTKEY(db)                       gdbm_firstkey(db)
  18 #define gdbm_NEXTKEY(db,key)                    gdbm_nextkey(db,key)
  19 #define gdbm_EXISTS(db,key)                     gdbm_exists(db,key)
  20
  21 typedef datum gdatum;
  22
  23 typedef void (*FATALFUNC)();
  24
  25 static int
  26 not_here(char *s)
  27 {
  28     croak("GDBM_File::%s not implemented on this architecture", s);
  29     return -1;
  30 }
  31
  32 /* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
  33    gdbm_exists, and gdbm_setopt functions.  Apparently Slackware
  34    (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
  35 */
  36 #ifndef GDBM_FAST
  37 #define gdbm_exists(db,key) not_here("gdbm_exists")
  38 #define gdbm_sync(db) (void) not_here("gdbm_sync")
  39 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
  40 #endif
  41
  42 static double
  43 constant(char *name, int arg)
  44 {
  45     errno = 0;
  46     switch (*name) {
  47     case 'A':
  48         break;
  49     case 'B':
  50         break;
  51     case 'C':
  52         break;
  53     case 'D':
  54         break;
  55     case 'E':
  56         break;
  57     case 'F':
  58         break;
  59     case 'G':
  60         if (strEQ(name, "GDBM_CACHESIZE"))
  61 #ifdef GDBM_CACHESIZE
  62             return GDBM_CACHESIZE;
  63 #else
  64             goto not_there;
  65 #endif
  66         if (strEQ(name, "GDBM_FAST"))
  67 #ifdef GDBM_FAST
  68             return GDBM_FAST;
  69 #else
  70             goto not_there;
  71 #endif
  72         if (strEQ(name, "GDBM_FASTMODE"))
  73 #ifdef GDBM_FASTMODE
  74             return GDBM_FASTMODE;
  75 #else
  76             goto not_there;
  77 #endif
  78         if (strEQ(name, "GDBM_INSERT"))
  79 #ifdef GDBM_INSERT
  80             return GDBM_INSERT;
  81 #else
  82             goto not_there;
  83 #endif
  84         if (strEQ(name, "GDBM_NEWDB"))
  85 #ifdef GDBM_NEWDB
  86             return GDBM_NEWDB;
  87 #else
  88             goto not_there;
  89 #endif
  90         if (strEQ(name, "GDBM_READER"))
  91 #ifdef GDBM_READER
  92             return GDBM_READER;
  93 #else
  94             goto not_there;
  95 #endif
  96         if (strEQ(name, "GDBM_REPLACE"))
  97 #ifdef GDBM_REPLACE
  98             return GDBM_REPLACE;
  99 #else
 100             goto not_there;
 101 #endif
 102         if (strEQ(name, "GDBM_WRCREAT"))
 103 #ifdef GDBM_WRCREAT
 104             return GDBM_WRCREAT;
 105 #else
 106             goto not_there;
 107 #endif
 108         if (strEQ(name, "GDBM_WRITER"))
 109 #ifdef GDBM_WRITER
 110             return GDBM_WRITER;
 111 #else
 112             goto not_there;
 113 #endif
 114         break;
 115     case 'H':
 116         break;
 117     case 'I':
 118         break;
 119     case 'J':
 120         break;
 121     case 'K':
 122         break;
 123     case 'L':
 124         break;
 125     case 'M':
 126         break;
 127     case 'N':
 128         break;
 129     case 'O':
 130         break;
 131     case 'P':
 132         break;
 133     case 'Q':
 134         break;
 135     case 'R':
 136         break;
 137     case 'S':
 138         break;
 139     case 'T':
 140         break;
 141     case 'U':
 142         break;
 143     case 'V':
 144         break;
 145     case 'W':
 146         break;
 147     case 'X':
 148         break;
 149     case 'Y':
 150         break;
 151     case 'Z':
 152         break;
 153     }
 154     errno = EINVAL;
 155     return 0;
 156
 157 not_there:
 158     errno = ENOENT;
 159     return 0;
 160 }
 161
 162 MODULE = GDBM_File      PACKAGE = GDBM_File     PREFIX = gdbm_
 163
 164 double
 165 constant(name,arg)
 166         char *          name
 167         int             arg
 168
 169
 170 GDBM_File
 171 gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
 172         char *          dbtype
 173         char *          name
 174         int             read_write
 175         int             mode
 176         FATALFUNC       fatal_func
 177
 178 void
 179 gdbm_close(db)
 180         GDBM_File       db
 181         CLEANUP:
 182
 183 void
 184 gdbm_DESTROY(db)
 185         GDBM_File       db
 186         CODE:
 187         gdbm_close(db);
 188
 189 gdatum
 190 gdbm_FETCH(db, key)
 191         GDBM_File       db
 192         datum           key
 193
 194 int
 195 gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
 196         GDBM_File       db
 197         datum           key
 198         datum           value
 199         int             flags
 200     CLEANUP:
 201         if (RETVAL) {
 202             if (RETVAL < 0 && errno == EPERM)
 203                 croak("No write permission to gdbm file");
 204             croak("gdbm store returned %d, errno %d, key \"%.*s\"",
 205                         RETVAL,errno,key.dsize,key.dptr);
 206             /* gdbm_clearerr(db); */
 207         }
 208
 209 int
 210 gdbm_DELETE(db, key)
 211         GDBM_File       db
 212         datum           key
 213
 214 gdatum
 215 gdbm_FIRSTKEY(db)
 216         GDBM_File       db
 217
 218 gdatum
 219 gdbm_NEXTKEY(db, key)
 220         GDBM_File       db
 221         datum           key
 222
 223 int
 224 gdbm_reorganize(db)
 225         GDBM_File       db
 226
 227
 228 void
 229 gdbm_sync(db)
 230         GDBM_File       db
 231
 232 int
 233 gdbm_EXISTS(db, key)
 234         GDBM_File       db
 235         datum           key
 236
 237 int
 238 gdbm_setopt (db, optflag, optval, optlen)
 239         GDBM_File       db
 240         int             optflag
 241         int             &optval
 242         int             optlen
 243