Update Changes.

[p5sagit/p5-mst-13.2.git] / ext / ODBM_File / ODBM_File.xs

diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
index b57e560..3bc94fe 100644 (file)
--- a/ext/ODBM_File/ODBM_File.xs
+++ b/ext/ODBM_File/ODBM_File.xs
@@ -2,10 +2,12 @@
 #include "perl.h"
 #include "XSUB.h"
 
-#ifdef NULL
-#undef NULL
-#endif
 #ifdef I_DBM
+/* If using the DB3 emulation, ENTER is defined both
+ * by DB3 and Perl.  We drop the Perl definition now.
+ * See also INSTALL section on DB3.
+ * -- Stanislav Brabec <utx@penguin.cz> */
+#  undef ENTER
 #  include <dbm.h>
 #else
 #  ifdef I_RPCSVC_DBM
@@ -13,6 +15,16 @@
 #  endif
 #endif
 
+#ifndef HAS_DBMINIT_PROTO
+int    dbminit(char* filename);
+int    dbmclose(void);
+datum  fetch(datum key);
+int    store(datum key, datum dat);
+int    delete(datum key);
+datum  firstkey(void);
+datum  nextkey(datum key);
+#endif
+
 #ifdef DBM_BUG_DUPLICATE_FREE 
 /*
  * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(),
@@ -30,7 +42,38 @@
 
 #include <fcntl.h>
 
-typedef void* ODBM_File;
+typedef struct {
+       void *  dbp ;
+       SV *    filter_fetch_key ;
+       SV *    filter_store_key ;
+       SV *    filter_fetch_value ;
+       SV *    filter_store_value ;
+       int     filtering ;
+       } ODBM_File_type;
+
+typedef ODBM_File_type * ODBM_File ;
+typedef datum datum_key ;
+typedef datum datum_key_copy ;
+typedef datum datum_value ;
+
+#define ckFilter(arg,type,name)                                        \
+       if (db->type) {                                         \
+           SV * save_defsv ;                                   \
+            /* printf("filtering %s\n", name) ;*/              \
+           if (db->filtering)                                  \
+               croak("recursion detected in %s", name) ;       \
+           db->filtering = TRUE ;                              \
+           save_defsv = newSVsv(DEFSV) ;                       \
+           sv_setsv(DEFSV, arg) ;                              \
+           PUSHMARK(sp) ;                                      \
+           (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);  \
+           sv_setsv(arg, DEFSV) ;                              \
+           sv_setsv(DEFSV, save_defsv) ;                       \
+           SvREFCNT_dec(save_defsv) ;                          \
+           db->filtering = FALSE ;                             \
+           /*printf("end of filtering %s\n", name) ;*/         \
+       }
+
 
 #define odbm_FETCH(db,key)                     fetch(key)
 #define odbm_STORE(db,key,value,flags)         store(key,value)
@@ -38,7 +81,15 @@ typedef void* ODBM_File;
 #define odbm_FIRSTKEY(db)                      firstkey()
 #define odbm_NEXTKEY(db,key)                   nextkey(key)
 
-static int dbmrefcnt;
+#define MY_CXT_KEY "ODBM_File::_guts" XS_VERSION
+
+typedef struct {
+    int                x_dbmrefcnt;
+} my_cxt_t;
+
+START_MY_CXT
+
+#define dbmrefcnt      (MY_CXT.x_dbmrefcnt)
 
 #ifndef DBM_REPLACE
 #define DBM_REPLACE 0
@@ -46,6 +97,11 @@ static int dbmrefcnt;
 
 MODULE = ODBM_File     PACKAGE = ODBM_File     PREFIX = odbm_
 
+BOOT:
+{
+    MY_CXT_INIT;
+}
+
 ODBM_File
 odbm_TIEHASH(dbtype, filename, flags, mode)
        char *          dbtype
@@ -55,12 +111,15 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
        CODE:
        {
            char *tmpbuf;
+           void * dbp ;
+           dMY_CXT;
+
            if (dbmrefcnt++)
                croak("Old dbm can only open one database");
            New(0, tmpbuf, strlen(filename) + 5, char);
            SAVEFREEPV(tmpbuf);
            sprintf(tmpbuf,"%s.dir",filename);
-           if (stat(tmpbuf, &statbuf) < 0) {
+           if (stat(tmpbuf, &PL_statbuf) < 0) {
                if (flags & O_CREAT) {
                    if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
                        croak("ODBM_File: Can't create %s", filename);
@@ -71,28 +130,34 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
                else
                    croak("ODBM_FILE: Can't open %s", filename);
            }
-           RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
-           ST(0) = sv_mortalcopy(&sv_undef);
+           dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
+           RETVAL = (ODBM_File)safemalloc(sizeof(ODBM_File_type)) ;
+           Zero(RETVAL, 1, ODBM_File_type) ;
+           RETVAL->dbp = dbp ;
+           ST(0) = sv_mortalcopy(&PL_sv_undef);
            sv_setptrobj(ST(0), RETVAL, dbtype);
        }
 
 void
 DESTROY(db)
        ODBM_File       db
+       PREINIT:
+       dMY_CXT;
        CODE:
        dbmrefcnt--;
        dbmclose();
+       safefree(db);
 
-datum
+datum_value
 odbm_FETCH(db, key)
        ODBM_File       db
-       datum           key
+       datum_key_copy  key
 
 int
 odbm_STORE(db, key, value, flags = DBM_REPLACE)
        ODBM_File       db
-       datum           key
-       datum           value
+       datum_key       key
+       datum_value     value
        int             flags
     CLEANUP:
        if (RETVAL) {
@@ -105,14 +170,66 @@ odbm_STORE(db, key, value, flags = DBM_REPLACE)
 int
 odbm_DELETE(db, key)
        ODBM_File       db
-       datum           key
+       datum_key       key
 
-datum
+datum_key
 odbm_FIRSTKEY(db)
        ODBM_File       db
 
-datum
+datum_key
 odbm_NEXTKEY(db, key)
        ODBM_File       db
-       datum           key
+       datum_key       key
+
+
+#define setFilter(type)                                        \
+       {                                               \
+           if (db->type)                               \
+               RETVAL = sv_mortalcopy(db->type) ;      \
+           ST(0) = RETVAL ;                            \
+           if (db->type && (code == &PL_sv_undef)) {   \
+                SvREFCNT_dec(db->type) ;               \
+               db->type = Nullsv ;                     \
+           }                                           \
+           else if (code) {                            \
+               if (db->type)                           \
+                   sv_setsv(db->type, code) ;          \
+               else                                    \
+                   db->type = newSVsv(code) ;          \
+           }                                           \
+       }
+
+
+
+SV *
+filter_fetch_key(db, code)
+       ODBM_File       db
+       SV *            code
+       SV *            RETVAL = &PL_sv_undef ;
+       CODE:
+           setFilter(filter_fetch_key) ;
+
+SV *
+filter_store_key(db, code)
+       ODBM_File       db
+       SV *            code
+       SV *            RETVAL =  &PL_sv_undef ;
+       CODE:
+           setFilter(filter_store_key) ;
+
+SV *
+filter_fetch_value(db, code)
+       ODBM_File       db
+       SV *            code
+       SV *            RETVAL =  &PL_sv_undef ;
+       CODE:
+           setFilter(filter_fetch_value) ;
+
+SV *
+filter_store_value(db, code)
+       ODBM_File       db
+       SV *            code
+       SV *            RETVAL =  &PL_sv_undef ;
+       CODE:
+           setFilter(filter_store_value) ;