ODBM_File.c

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #ifdef NULL
   6 #undef NULL
   7 #endif
   8 #include <dbm.h>
   9
  10 #include <fcntl.h>
  11
  12 typedef void* ODBM_File;
  13
  14 #define odbm_fetch(db,key)                      fetch(key)
  15 #define odbm_store(db,key,value,flags)          store(key,value)
  16 #define odbm_delete(db,key)                     delete(key)
  17 #define odbm_firstkey(db)                       firstkey()
  18 #define odbm_nextkey(db,key)                    nextkey(key)
  19
  20 static int dbmrefcnt;
  21
  22 #define DBM_REPLACE 0
  23
  24 static int
  25 XS_ODBM_File_odbm_new(ix, sp, items)
  26 register int ix;
  27 register int sp;
  28 register int items;
  29 {
  30     if (items < 4 || items > 4) {
  31         croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)");
  32     }
  33     {
  34         char *  dbtype = SvPV(ST(1),na);
  35         char *  filename = SvPV(ST(2),na);
  36         int     flags = (int)SvIV(ST(3));
  37         int     mode = (int)SvIV(ST(4));
  38         ODBM_File       RETVAL;
  39         {
  40             char tmpbuf[1025];
  41             if (dbmrefcnt++)
  42                 croak("Old dbm can only open one database");
  43             sprintf(tmpbuf,"%s.dir",filename);
  44             if (stat(tmpbuf, &statbuf) < 0) {
  45                 if (flags & O_CREAT) {
  46                     if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
  47                         croak("ODBM_File: Can't create %s", filename);
  48                     sprintf(tmpbuf,"%s.pag",filename);
  49                     if (close(creat(tmpbuf,mode)) < 0)
  50                         croak("ODBM_File: Can't create %s", filename);
  51                 }
  52                 else
  53                     croak("ODBM_FILE: Can't open %s", filename);
  54             }
  55             RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
  56             ST(0) = sv_mortalcopy(&sv_undef);
  57             sv_setptrobj(ST(0), RETVAL, "ODBM_File");
  58         }
  59     }
  60     return sp;
  61 }
  62
  63 static int
  64 XS_ODBM_File_DESTROY(ix, sp, items)
  65 register int ix;
  66 register int sp;
  67 register int items;
  68 {
  69     if (items < 1 || items > 1) {
  70         croak("Usage: ODBM_File::DESTROY(db)");
  71     }
  72     {
  73         ODBM_File       db;
  74
  75         if (sv_isa(ST(1), "ODBM_File"))
  76             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
  77         else
  78             croak("db is not of type ODBM_File");
  79         dbmrefcnt--;
  80         dbmclose();
  81     }
  82     return sp;
  83 }
  84
  85 static int
  86 XS_ODBM_File_odbm_fetch(ix, sp, items)
  87 register int ix;
  88 register int sp;
  89 register int items;
  90 {
  91     if (items < 2 || items > 2) {
  92         croak("Usage: ODBM_File::fetch(db, key)");
  93     }
  94     {
  95         ODBM_File       db;
  96         datum   key;
  97         datum   RETVAL;
  98
  99         if (sv_isa(ST(1), "ODBM_File"))
 100             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
 101         else
 102             croak("db is not of type ODBM_File");
 103
 104         key.dptr = SvPV(ST(2), key.dsize);;
 105
 106         RETVAL = odbm_fetch(db, key);
 107         ST(0) = sv_mortalcopy(&sv_undef);
 108         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
 109     }
 110     return sp;
 111 }
 112
 113 static int
 114 XS_ODBM_File_odbm_store(ix, sp, items)
 115 register int ix;
 116 register int sp;
 117 register int items;
 118 {
 119     if (items < 3 || items > 4) {
 120         croak("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)");
 121     }
 122     {
 123         ODBM_File       db;
 124         datum   key;
 125         datum   value;
 126         int     flags;
 127         int     RETVAL;
 128
 129         if (sv_isa(ST(1), "ODBM_File"))
 130             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
 131         else
 132             croak("db is not of type ODBM_File");
 133
 134         key.dptr = SvPV(ST(2), key.dsize);;
 135
 136         value.dptr = SvPV(ST(3), value.dsize);;
 137
 138         if (items < 4)
 139             flags = DBM_REPLACE;
 140         else {
 141             flags = (int)SvIV(ST(4));
 142         }
 143
 144         RETVAL = odbm_store(db, key, value, flags);
 145         ST(0) = sv_mortalcopy(&sv_undef);
 146         sv_setiv(ST(0), (I32)RETVAL);
 147     }
 148     return sp;
 149 }
 150
 151 static int
 152 XS_ODBM_File_odbm_delete(ix, sp, items)
 153 register int ix;
 154 register int sp;
 155 register int items;
 156 {
 157     if (items < 2 || items > 2) {
 158         croak("Usage: ODBM_File::delete(db, key)");
 159     }
 160     {
 161         ODBM_File       db;
 162         datum   key;
 163         int     RETVAL;
 164
 165         if (sv_isa(ST(1), "ODBM_File"))
 166             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
 167         else
 168             croak("db is not of type ODBM_File");
 169
 170         key.dptr = SvPV(ST(2), key.dsize);;
 171
 172         RETVAL = odbm_delete(db, key);
 173         ST(0) = sv_mortalcopy(&sv_undef);
 174         sv_setiv(ST(0), (I32)RETVAL);
 175     }
 176     return sp;
 177 }
 178
 179 static int
 180 XS_ODBM_File_odbm_firstkey(ix, sp, items)
 181 register int ix;
 182 register int sp;
 183 register int items;
 184 {
 185     if (items < 1 || items > 1) {
 186         croak("Usage: ODBM_File::firstkey(db)");
 187     }
 188     {
 189         ODBM_File       db;
 190         datum   RETVAL;
 191
 192         if (sv_isa(ST(1), "ODBM_File"))
 193             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
 194         else
 195             croak("db is not of type ODBM_File");
 196
 197         RETVAL = odbm_firstkey(db);
 198         ST(0) = sv_mortalcopy(&sv_undef);
 199         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
 200     }
 201     return sp;
 202 }
 203
 204 static int
 205 XS_ODBM_File_odbm_nextkey(ix, sp, items)
 206 register int ix;
 207 register int sp;
 208 register int items;
 209 {
 210     if (items < 2 || items > 2) {
 211         croak("Usage: ODBM_File::nextkey(db, key)");
 212     }
 213     {
 214         ODBM_File       db;
 215         datum   key;
 216         datum   RETVAL;
 217
 218         if (sv_isa(ST(1), "ODBM_File"))
 219             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
 220         else
 221             croak("db is not of type ODBM_File");
 222
 223         key.dptr = SvPV(ST(2), key.dsize);;
 224
 225         RETVAL = odbm_nextkey(db, key);
 226         ST(0) = sv_mortalcopy(&sv_undef);
 227         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
 228     }
 229     return sp;
 230 }
 231
 232 int init_ODBM_File(ix,sp,items)
 233 int ix;
 234 int sp;
 235 int items;
 236 {
 237     char* file = __FILE__;
 238
 239     newXSUB("ODBM_File::new", 0, XS_ODBM_File_odbm_new, file);
 240     newXSUB("ODBM_File::DESTROY", 0, XS_ODBM_File_DESTROY, file);
 241     newXSUB("ODBM_File::fetch", 0, XS_ODBM_File_odbm_fetch, file);
 242     newXSUB("ODBM_File::store", 0, XS_ODBM_File_odbm_store, file);
 243     newXSUB("ODBM_File::delete", 0, XS_ODBM_File_odbm_delete, file);
 244     newXSUB("ODBM_File::firstkey", 0, XS_ODBM_File_odbm_firstkey, file);
 245     newXSUB("ODBM_File::nextkey", 0, XS_ODBM_File_odbm_nextkey, file);
 246 }