ext/NDBM_File/NDBM_File.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4 #include <ndbm.h>
   5
   6 typedef struct {
   7         DBM *   dbp ;
   8         SV *    filter_fetch_key ;
   9         SV *    filter_store_key ;
  10         SV *    filter_fetch_value ;
  11         SV *    filter_store_value ;
  12         int     filtering ;
  13         } NDBM_File_type;
  14
  15 typedef NDBM_File_type * NDBM_File ;
  16 typedef datum datum_key ;
  17 typedef datum datum_value ;
  18
  19 #define ckFilter(arg,type,name)                                 \
  20         if (db->type) {                                         \
  21             SV * save_defsv ;                                   \
  22             /* printf("filtering %s\n", name) ;*/               \
  23             if (db->filtering)                                  \
  24                 croak("recursion detected in %s", name) ;       \
  25             db->filtering = TRUE ;                              \
  26             save_defsv = newSVsv(DEFSV) ;                       \
  27             sv_setsv(DEFSV, arg) ;                              \
  28             PUSHMARK(sp) ;                                      \
  29             (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);  \
  30             sv_setsv(arg, DEFSV) ;                              \
  31             sv_setsv(DEFSV, save_defsv) ;                       \
  32             SvREFCNT_dec(save_defsv) ;                          \
  33             db->filtering = FALSE ;                             \
  34             /*printf("end of filtering %s\n", name) ;*/         \
  35         }
  36
  37
  38 MODULE = NDBM_File      PACKAGE = NDBM_File     PREFIX = dbm_
  39
  40 NDBM_File
  41 dbm_TIEHASH(dbtype, filename, flags, mode)
  42         char *          dbtype
  43         char *          filename
  44         int             flags
  45         int             mode
  46         CODE:
  47         {
  48             DBM *       dbp ;
  49
  50             RETVAL = NULL ;
  51             if (dbp =  dbm_open(filename, flags, mode)) {
  52                 RETVAL = (NDBM_File)safemalloc(sizeof(NDBM_File_type)) ;
  53                 Zero(RETVAL, 1, NDBM_File_type) ;
  54                 RETVAL->dbp = dbp ;
  55             }
  56
  57         }
  58         OUTPUT:
  59           RETVAL
  60
  61 void
  62 dbm_DESTROY(db)
  63         NDBM_File       db
  64         CODE:
  65         dbm_close(db->dbp);
  66
  67 #define dbm_FETCH(db,key)                       dbm_fetch(db->dbp,key)
  68 datum_value
  69 dbm_FETCH(db, key)
  70         NDBM_File       db
  71         datum_key       key
  72
  73 #define dbm_STORE(db,key,value,flags)           dbm_store(db->dbp,key,value,flags)
  74 int
  75 dbm_STORE(db, key, value, flags = DBM_REPLACE)
  76         NDBM_File       db
  77         datum_key       key
  78         datum_value     value
  79         int             flags
  80     CLEANUP:
  81         if (RETVAL) {
  82             if (RETVAL < 0 && errno == EPERM)
  83                 croak("No write permission to ndbm file");
  84             croak("ndbm store returned %d, errno %d, key \"%s\"",
  85                         RETVAL,errno,key.dptr);
  86             dbm_clearerr(db->dbp);
  87         }
  88
  89 #define dbm_DELETE(db,key)                      dbm_delete(db->dbp,key)
  90 int
  91 dbm_DELETE(db, key)
  92         NDBM_File       db
  93         datum_key       key
  94
  95 #define dbm_FIRSTKEY(db)                        dbm_firstkey(db->dbp)
  96 datum_key
  97 dbm_FIRSTKEY(db)
  98         NDBM_File       db
  99
 100 #define dbm_NEXTKEY(db,key)                     dbm_nextkey(db->dbp)
 101 datum_key
 102 dbm_NEXTKEY(db, key)
 103         NDBM_File       db
 104         datum_key       key
 105
 106 #define dbm_error(db)                           dbm_error(db->dbp)
 107 int
 108 dbm_error(db)
 109         NDBM_File       db
 110
 111 #define dbm_clearerr(db)                        dbm_clearerr(db->dbp)
 112 void
 113 dbm_clearerr(db)
 114         NDBM_File       db
 115
 116
 117 #define setFilter(type)                                 \
 118         {                                               \
 119             if (db->type)                               \
 120                 RETVAL = newSVsv(db->type) ;            \
 121             if (db->type && (code == &PL_sv_undef)) {   \
 122                 SvREFCNT_dec(db->type) ;                \
 123                 db->type = NULL ;                       \
 124             }                                           \
 125             else if (code) {                            \
 126                 if (db->type)                           \
 127                     sv_setsv(db->type, code) ;          \
 128                 else                                    \
 129                     db->type = newSVsv(code) ;          \
 130             }                                           \
 131         }
 132
 133
 134
 135 SV *
 136 filter_fetch_key(db, code)
 137         NDBM_File       db
 138         SV *            code
 139         SV *            RETVAL = &PL_sv_undef ;
 140         CODE:
 141             setFilter(filter_fetch_key) ;
 142         OUTPUT:
 143             RETVAL
 144
 145 SV *
 146 filter_store_key(db, code)
 147         NDBM_File       db
 148         SV *            code
 149         SV *            RETVAL =  &PL_sv_undef ;
 150         CODE:
 151             setFilter(filter_store_key) ;
 152         OUTPUT:
 153             RETVAL
 154
 155 SV *
 156 filter_fetch_value(db, code)
 157         NDBM_File       db
 158         SV *            code
 159         SV *            RETVAL =  &PL_sv_undef ;
 160         CODE:
 161             setFilter(filter_fetch_value) ;
 162         OUTPUT:
 163             RETVAL
 164
 165 SV *
 166 filter_store_value(db, code)
 167         NDBM_File       db
 168         SV *            code
 169         SV *            RETVAL =  &PL_sv_undef ;
 170         CODE:
 171             setFilter(filter_store_value) ;
 172         OUTPUT:
 173             RETVAL
 174