ext/SDBM_File/SDBM_File.xs

   1 #define PERL_NO_GET_CONTEXT
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5 #include "sdbm/sdbm.h"
   6
   7 #define fetch_key 0
   8 #define store_key 1
   9 #define fetch_value 2
  10 #define store_value 3
  11
  12 typedef struct {
  13         DBM *   dbp ;
  14         SV *    filter[4];
  15         int     filtering ;
  16         } SDBM_File_type;
  17
  18 typedef SDBM_File_type * SDBM_File ;
  19 typedef datum datum_key ;
  20 typedef datum datum_value ;
  21
  22 #define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
  23 #define sdbm_FETCH(db,key)                      sdbm_fetch(db->dbp,key)
  24 #define sdbm_STORE(db,key,value,flags)          sdbm_store(db->dbp,key,value,flags)
  25 #define sdbm_DELETE(db,key)                     sdbm_delete(db->dbp,key)
  26 #define sdbm_EXISTS(db,key)                     sdbm_exists(db->dbp,key)
  27 #define sdbm_FIRSTKEY(db)                       sdbm_firstkey(db->dbp)
  28 #define sdbm_NEXTKEY(db,key)                    sdbm_nextkey(db->dbp)
  29
  30
  31 MODULE = SDBM_File      PACKAGE = SDBM_File     PREFIX = sdbm_
  32
  33 SDBM_File
  34 sdbm_TIEHASH(dbtype, filename, flags, mode)
  35         char *          dbtype
  36         char *          filename
  37         int             flags
  38         int             mode
  39         CODE:
  40         {
  41             DBM *       dbp ;
  42
  43             RETVAL = NULL ;
  44             if ((dbp = sdbm_open(filename,flags,mode))) {
  45                 RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
  46                 RETVAL->dbp = dbp ;
  47             }
  48
  49         }
  50         OUTPUT:
  51           RETVAL
  52
  53 void
  54 sdbm_DESTROY(db)
  55         SDBM_File       db
  56         CODE:
  57         if (db) {
  58             int i = store_value;
  59             sdbm_close(db->dbp);
  60             do {
  61                 if (db->filter[i])
  62                     SvREFCNT_dec(db->filter[i]);
  63             } while (i-- > 0);
  64             safefree(db) ;
  65         }
  66
  67 datum_value
  68 sdbm_FETCH(db, key)
  69         SDBM_File       db
  70         datum_key       key
  71
  72 int
  73 sdbm_STORE(db, key, value, flags = DBM_REPLACE)
  74         SDBM_File       db
  75         datum_key       key
  76         datum_value     value
  77         int             flags
  78     CLEANUP:
  79         if (RETVAL) {
  80             if (RETVAL < 0 && errno == EPERM)
  81                 croak("No write permission to sdbm file");
  82             croak("sdbm store returned %d, errno %d, key \"%s\"",
  83                         RETVAL,errno,key.dptr);
  84             sdbm_clearerr(db->dbp);
  85         }
  86
  87 int
  88 sdbm_DELETE(db, key)
  89         SDBM_File       db
  90         datum_key       key
  91
  92 int
  93 sdbm_EXISTS(db,key)
  94         SDBM_File       db
  95         datum_key       key
  96
  97 datum_key
  98 sdbm_FIRSTKEY(db)
  99         SDBM_File       db
 100
 101 datum_key
 102 sdbm_NEXTKEY(db, key)
 103         SDBM_File       db
 104         datum_key       key;
 105
 106 int
 107 sdbm_error(db)
 108         SDBM_File       db
 109         ALIAS:
 110         sdbm_clearerr = 1
 111         CODE:
 112         RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp);
 113         OUTPUT:
 114           RETVAL
 115
 116 SV *
 117 filter_fetch_key(db, code)
 118         SDBM_File       db
 119         SV *            code
 120         SV *            RETVAL = &PL_sv_undef ;
 121         ALIAS:
 122         SDBM_File::filter_fetch_key = fetch_key
 123         SDBM_File::filter_store_key = store_key
 124         SDBM_File::filter_fetch_value = fetch_value
 125         SDBM_File::filter_store_value = store_value
 126         CODE:
 127             DBM_setFilter(db->filter[ix], code);