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.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_FETCH(db,key)                      sdbm_fetch(db->dbp,key)
  23 #define sdbm_STORE(db,key,value,flags)          sdbm_store(db->dbp,key,value,flags)
  24 #define sdbm_DELETE(db,key)                     sdbm_delete(db->dbp,key)
  25 #define sdbm_EXISTS(db,key)                     sdbm_exists(db->dbp,key)
  26 #define sdbm_FIRSTKEY(db)                       sdbm_firstkey(db->dbp)
  27 #define sdbm_NEXTKEY(db,key)                    sdbm_nextkey(db->dbp)
  28
  29
  30 MODULE = SDBM_File      PACKAGE = SDBM_File     PREFIX = sdbm_
  31
  32 SDBM_File
  33 sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)
  34         char *          dbtype
  35         char *          filename
  36         int             flags
  37         int             mode
  38         char *          pagname
  39         CODE:
  40         {
  41             DBM *       dbp ;
  42
  43             RETVAL = NULL ;
  44             if (pagname == NULL) {
  45                 dbp = sdbm_open(filename, flags, mode);
  46             }
  47             else {
  48                 dbp = sdbm_prep(filename, pagname, flags, mode);
  49             }
  50             if (dbp) {
  51                 RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
  52                 RETVAL->dbp = dbp ;
  53             }
  54
  55         }
  56         OUTPUT:
  57           RETVAL
  58
  59 void
  60 sdbm_DESTROY(db)
  61         SDBM_File       db
  62         CODE:
  63         if (db) {
  64             int i = store_value;
  65             sdbm_close(db->dbp);
  66             do {
  67                 if (db->filter[i])
  68                     SvREFCNT_dec_NN(db->filter[i]);
  69             } while (i-- > 0);
  70             safefree(db) ;
  71         }
  72
  73 datum_value
  74 sdbm_FETCH(db, key)
  75         SDBM_File       db
  76         datum_key       key
  77
  78 int
  79 sdbm_STORE(db, key, value, flags = DBM_REPLACE)
  80         SDBM_File       db
  81         datum_key       key
  82         datum_value     value
  83         int             flags
  84     CLEANUP:
  85         if (RETVAL) {
  86             if (RETVAL < 0 && errno == EPERM)
  87                 croak("No write permission to sdbm file");
  88             croak("sdbm store returned %d, errno %d, key \"%s\"",
  89                         RETVAL,errno,key.dptr);
  90             sdbm_clearerr(db->dbp);
  91         }
  92
  93 int
  94 sdbm_DELETE(db, key)
  95         SDBM_File       db
  96         datum_key       key
  97
  98 int
  99 sdbm_EXISTS(db,key)
 100         SDBM_File       db
 101         datum_key       key
 102
 103 datum_key
 104 sdbm_FIRSTKEY(db)
 105         SDBM_File       db
 106
 107 datum_key
 108 sdbm_NEXTKEY(db, key)
 109         SDBM_File       db
 110
 111 int
 112 sdbm_error(db)
 113         SDBM_File       db
 114         ALIAS:
 115         sdbm_clearerr = 1
 116         CODE:
 117         RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp);
 118         OUTPUT:
 119           RETVAL
 120
 121 SV *
 122 filter_fetch_key(db, code)
 123         SDBM_File       db
 124         SV *            code
 125         SV *            RETVAL = &PL_sv_undef ;
 126         ALIAS:
 127         SDBM_File::filter_fetch_key = fetch_key
 128         SDBM_File::filter_store_key = store_key
 129         SDBM_File::filter_fetch_value = fetch_value
 130         SDBM_File::filter_store_value = store_value
 131         CODE:
 132             DBM_setFilter(db->filter[ix], code);
 133
 134 BOOT:
 135         {
 136             HV *stash = gv_stashpvs("SDBM_File", 1);
 137             newCONSTSUB(stash, "PAGFEXT", newSVpvs(PAGFEXT));
 138             newCONSTSUB(stash, "DIRFEXT", newSVpvs(DIRFEXT));
 139             newCONSTSUB(stash, "PAIRMAX", newSVuv(PAIRMAX));
 140         }