integrate cfgperl contents

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

diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index be584a2..ed3a7fa 100644 (file)
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -3,8 +3,8 @@
  DB_File.xs -- Perl 5 interface to Berkeley DB 
 
  written by Paul Marquess <Paul.Marquess@btinternet.com>
- last modified 6th March 1999
- version 1.66
+ last modified 6th June 1999
+ version 1.67
 
  All comments/suggestions/problems are welcome
 
@@ -66,6 +66,9 @@
         1.65 -  Fixed a bug in the PUSH logic.
                Added BOOT check that using 2.3.4 or greater
         1.66 -  Added DBM filter code
+        1.67 -  Backed off the use of newSVpvn.
+               Fixed DBM Filter code for Perl 5.004.
+               Fixed a small memory leak in the filter code.
 
 
 
@@ -89,6 +92,11 @@
 
 #endif
 
+/* DEFSV appears first in 5.004_56 */
+#ifndef DEFSV
+#define DEFSV          GvSV(defgv)
+#endif
+
 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
  * shortly #included by the <db.h>) __attribute__ to the possibly
  * already defined __attribute__, for example by GNUC or by Perl. */
@@ -301,16 +309,13 @@ typedef DBT DBTKEY ;
            if (db->filtering)                                  \
                croak("recursion detected in %s", name) ;       \
            db->filtering = TRUE ;                              \
-           /* SAVE_DEFSV ;*/   /* save $_ */                   \
            save_defsv = newSVsv(DEFSV) ;                       \
            sv_setsv(DEFSV, arg) ;                              \
            PUSHMARK(sp) ;                                      \
            (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);  \
-           /* SPAGAIN ; */                                             \
            sv_setsv(arg, DEFSV) ;                              \
-           sv_setsv(DEFSV, save_defsv) ;                               \
+           sv_setsv(DEFSV, save_defsv) ;                       \
            SvREFCNT_dec(save_defsv) ;                          \
-           /* PUTBACK ; */                                             \
            db->filtering = FALSE ;                             \
            /*printf("end of filtering %s\n", name) ;*/         \
        }
@@ -417,7 +422,7 @@ btree_compare(const DBT *key1, const DBT *key2)
     
     data1 = key1->data ;
     data2 = key2->data ;
-#if 0
+
     /* As newSVpv will assume that the data pointer is a null terminated C 
        string if the size parameter is 0, make sure that data points to an 
        empty string if the length is 0
@@ -426,14 +431,14 @@ btree_compare(const DBT *key1, const DBT *key2)
         data1 = "" ; 
     if (key2->size == 0)
         data2 = "" ;
-#endif
+
     ENTER ;
     SAVETMPS;
 
     PUSHMARK(SP) ;
     EXTEND(SP,2) ;
-    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
-    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
+    PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
+    PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
     PUTBACK ;
 
     count = perl_call_sv(CurrentDB->compare, G_SCALAR); 
@@ -463,7 +468,7 @@ btree_prefix(const DBT *key1, const DBT *key2)
     
     data1 = key1->data ;
     data2 = key2->data ;
-#if 0
+
     /* As newSVpv will assume that the data pointer is a null terminated C 
        string if the size parameter is 0, make sure that data points to an 
        empty string if the length is 0
@@ -472,14 +477,14 @@ btree_prefix(const DBT *key1, const DBT *key2)
         data1 = "" ;
     if (key2->size == 0)
         data2 = "" ;
-#endif
+
     ENTER ;
     SAVETMPS;
 
     PUSHMARK(SP) ;
     EXTEND(SP,2) ;
-    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
-    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
+    PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
+    PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
     PUTBACK ;
 
     count = perl_call_sv(CurrentDB->prefix, G_SCALAR); 
@@ -505,17 +510,17 @@ hash_cb(const void *data, size_t size)
     dSP ;
     int retval ;
     int count ;
-#if 0
+
     if (size == 0)
         data = "" ;
-#endif
+
      /* DGH - Next two lines added to fix corrupted stack problem */
     ENTER ;
     SAVETMPS;
 
     PUSHMARK(SP) ;
 
-    XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
+    XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
     PUTBACK ;
 
     count = perl_call_sv(CurrentDB->hash, G_SCALAR); 
@@ -1564,7 +1569,8 @@ db_seq(db, key, value, flags)
 #define setFilter(type)                                        \
        {                                               \
            if (db->type)                               \
-               RETVAL = newSVsv(db->type) ;            \
+               RETVAL = sv_mortalcopy(db->type) ;      \
+           ST(0) = RETVAL ;                            \
            if (db->type && (code == &PL_sv_undef)) {   \
                 SvREFCNT_dec(db->type) ;               \
                db->type = NULL ;                       \
@@ -1585,8 +1591,6 @@ filter_fetch_key(db, code)
        SV *            RETVAL = &PL_sv_undef ;
        CODE:
            setFilter(filter_fetch_key) ;
-       OUTPUT:
-           RETVAL
 
 SV *
 filter_store_key(db, code)
@@ -1595,8 +1599,6 @@ filter_store_key(db, code)
        SV *            RETVAL = &PL_sv_undef ;
        CODE:
            setFilter(filter_store_key) ;
-       OUTPUT:
-           RETVAL
 
 SV *
 filter_fetch_value(db, code)
@@ -1605,8 +1607,6 @@ filter_fetch_value(db, code)
        SV *            RETVAL = &PL_sv_undef ;
        CODE:
            setFilter(filter_fetch_value) ;
-       OUTPUT:
-           RETVAL
 
 SV *
 filter_store_value(db, code)
@@ -1615,7 +1615,5 @@ filter_store_value(db, code)
        SV *            RETVAL = &PL_sv_undef ;
        CODE:
            setFilter(filter_store_value) ;
-       OUTPUT:
-           RETVAL
 
 #endif /* DBM_FILTERING */