As we're not passing over (or copying in) a NUL, don't need that extra

[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 aa5d135..7cbe5e8 100644 (file)
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -2,13 +2,13 @@
 
  DB_File.xs -- Perl 5 interface to Berkeley DB 
 
- written by Paul Marquess <Paul.Marquess@btinternet.com>
- last modified 22nd October 2002
- version 1.806
+ written by Paul Marquess <pmqs@cpan.org>
+ last modified 11th November 2005
+ version 1.814
 
  All comments/suggestions/problems are welcome
 
-     Copyright (c) 1995-2002 Paul Marquess. All rights reserved.
+     Copyright (c) 1995-2005 Paul Marquess. All rights reserved.
      This program is free software; you can redistribute it and/or
      modify it under the same terms as Perl itself.
 
@@ -106,6 +106,14 @@
                 Support for 4.1.X added.
                 Filter code can now cope with read-only $_
         1.806 - recursion detection beefed up.
+        1.807 - no change
+        1.808 - leak fixed in ParseOpenInfo
+        1.809 - no change
+        1.810 - no change
+        1.811 - no change
+        1.812 - no change
+        1.813 - no change
+        1.814 - no change
 
 */
 
@@ -187,10 +195,22 @@
 #    define AT_LEAST_DB_3_2
 #endif
 
+#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 3)
+#    define AT_LEAST_DB_3_3
+#endif
+
 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
 #    define AT_LEAST_DB_4_1
 #endif
 
+#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 3)
+#    define AT_LEAST_DB_4_3
+#endif
+
+#ifdef AT_LEAST_DB_3_3
+#   define WANT_ERROR
+#endif
+
 /* map version 2 features & constants onto their version 1 equivalent */
 
 #ifdef DB_Prefix_t
@@ -390,13 +410,15 @@ typedef struct {
 typedef DB_File_type * DB_File ;
 typedef DBT DBTKEY ;
 
-#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
+#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (const char *)""), s)
 
 #define OutputValue(arg, name)                                         \
        { if (RETVAL == 0) {                                            \
-             my_sv_setpvn(arg, name.data, name.size) ;                 \
-             TAINT;                                            \
+             SvGETMAGIC(arg) ;                                         \
+             my_sv_setpvn(arg, (const char *)name.data, name.size) ;                   \
+             TAINT;                                                    \
              SvTAINTED_on(arg);                                        \
+             SvUTF8_off(arg);                                          \
              DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ;      \
          }                                                             \
        }
@@ -404,13 +426,15 @@ typedef DBT DBTKEY ;
 #define OutputKey(arg, name)                                           \
        { if (RETVAL == 0)                                              \
          {                                                             \
+               SvGETMAGIC(arg) ;                                       \
                if (db->type != DB_RECNO) {                             \
-                   my_sv_setpvn(arg, name.data, name.size);            \
+                   my_sv_setpvn(arg, (const char *)name.data, name.size);              \
                }                                                       \
                else                                                    \
                    sv_setiv(arg, (I32)*(I32*)name.data - 1);           \
-             TAINT;                                            \
+             TAINT;                                                    \
              SvTAINTED_on(arg);                                        \
+             SvUTF8_off(arg);                                          \
              DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ;  \
          }                                                             \
        }
@@ -573,8 +597,8 @@ const DBT * key2 ;
 
     PUSHMARK(SP) ;
     EXTEND(SP,2) ;
-    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
-    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
+    PUSHs(sv_2mortal(newSVpvn((const char*)data1,key1->size)));
+    PUSHs(sv_2mortal(newSVpvn((const char*)data2,key2->size)));
     PUTBACK ;
 
     count = perl_call_sv(CurrentDB->compare, G_SCALAR); 
@@ -760,14 +784,13 @@ HASH_CB_SIZE_TYPE size ;
     return (retval) ;
 }
 
-#if 0
+#ifdef WANT_ERROR
+
 static void
-#ifdef CAN_PROTOTYPE
-db_errcall_cb(const char * db_errpfx, char * buffer)
+#ifdef AT_LEAST_DB_4_3
+db_errcall_cb(const DB_ENV* dbenv, const char * db_errpfx, const char * buffer)
 #else
-db_errcall_cb(db_errpfx, buffer)
-const char * db_errpfx;
-char * buffer;
+db_errcall_cb(const char * db_errpfx, char * buffer)
 #endif
 {
 #ifdef dTHX
@@ -928,7 +951,10 @@ SV *   sv ;
     STRLEN     n_a;
     dMY_CXT;
 
-/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
+#ifdef TRACE    
+    printf("In ParseOpenInfo name=[%s] flags=[%d] mode=[%d] SV NULL=[%d]\n", 
+                   name, flags, mode, sv == NULL) ;  
+#endif
     Zero(RETVAL, 1, DB_File_type) ;
 
     /* Default to HASH */
@@ -1224,6 +1250,9 @@ SV *   sv ;
     }  
     dbp = RETVAL->dbp ;
 
+#ifdef WANT_ERROR
+           RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ;
+#endif
     if (sv)
     {
         if (! SvROK(sv) )
@@ -1418,6 +1447,12 @@ SV *   sv ;
             Flags |= DB_TRUNCATE ;
 #endif
 
+#ifdef AT_LEAST_DB_4_4
+        /* need this for recno */
+        if ((flags & O_TRUNC) == O_TRUNC)
+            Flags |= DB_CREATE ;
+#endif
+
 #ifdef AT_LEAST_DB_4_1
         status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type, 
                                Flags, mode) ; 
@@ -1428,7 +1463,6 @@ SV *   sv ;
        /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
 
         if (status == 0) {
-           /* RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ;*/
 
             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
                        0) ;
@@ -1458,7 +1492,9 @@ BOOT:
 #ifdef dTHX
     dTHX;
 #endif    
-    /* SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ;  */
+#ifdef WANT_ERROR
+    SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ; 
+#endif
     MY_CXT_INIT;
     __getBerkeleyDBInfo() ;
  
@@ -1488,8 +1524,10 @@ db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_H
                sv = ST(5) ;
 
            RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
-           if (RETVAL->dbp == NULL)
+           if (RETVAL->dbp == NULL) {
+               Safefree(RETVAL);
                RETVAL = NULL ;
+           }
        }
        OUTPUT: 
            RETVAL
@@ -1652,7 +1690,8 @@ unshift(db, ...)
 #endif
            for (i = items-1 ; i > 0 ; --i)
            {
-               value.data = SvPV(ST(i), n_a) ;
+               DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
+               value.data = SvPVbyte(ST(i), n_a) ;
                value.size = n_a ;
                One = 1 ;
                key.data = &One ;
@@ -1761,7 +1800,8 @@ push(db, ...)
                    keyval = 0 ;
                for (i = 1 ; i < items ; ++i)
                {
-                   value.data = SvPV(ST(i), n_a) ;
+                   DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
+                   value.data = SvPVbyte(ST(i), n_a) ;
                    value.size = n_a ;
                    ++ keyval ;
                    key.data = &keyval ;