X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FDB_File%2FDB_File.xs;h=ed3a7fa3e044f780dbf1e74f53123b73ec7525ba;hb=3e3318e754fa4289ad1c682811dbe6a31cd59e26;hp=be584a2ce6c55df7b2cd46a9120dd39de871b8bf;hpb=b76802f5349f9b9be2e0dcf5948c4c7a2fa57d98;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index be584a2..ed3a7fa 100644
--- 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 */