Upgrade to DB_File 1.813.

p4raw-id: //depot/perl@25942

diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes
index 5479a11..e5f1c32 100644 (file)
--- a/ext/DB_File/Changes
+++ b/ext/DB_File/Changes
@@ -1,5 +1,9 @@
 
 
+1.813 31st October 2005
+
+   * Updates for Berkeley DB 4.4
+
 1.812 9th October 2005
 
    * Added libscan to Makefile.PL

diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index c6e6e44..ccaf44f 100644 (file)
--- a/ext/DB_File/DB_File.pm
+++ b/ext/DB_File/DB_File.pm
@@ -1,8 +1,8 @@
 # DB_File.pm -- Perl 5 interface to Berkeley DB 
 #
 # written by Paul Marquess (pmqs@cpan.org)
-# last modified 9th October 2005
-# version 1.812
+# last modified 31st October 2005
+# version 1.813
 #
 #     Copyright (c) 1995-2005 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
@@ -165,7 +165,7 @@ our ($db_version, $use_XSLoader, $splice_end_array);
 use Carp;
 
 
-$VERSION = "1.812" ;
+$VERSION = "1.813" ;
 
 {
     local $SIG{__WARN__} = sub {$splice_end_array = "@_";};
@@ -268,6 +268,10 @@ sub tie_hash_or_array
 
     # make recno in Berkeley DB version 2 (or better) work like 
     # recno in version 1.
+    if ($db_version >= 4 and ! $tieHASH) {
+        $arg[2] |= O_CREAT();
+    }
+
     if ($db_version > 1 and defined $arg[4] and $arg[4] =~ /RECNO/ and 
        $arg[1] and ! -e $arg[1]) {
        open(FH, ">$arg[1]") or return undef ;

diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index 0e6fe2a..5b36ae6 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 <pmqs@cpan.org>
- last modified 12th March 2005
- version 1.812
+ last modified 31st October 2005
+ version 1.813
 
  All comments/suggestions/problems are welcome
 
@@ -112,6 +112,7 @@
         1.810 - no change
         1.811 - no change
         1.812 - no change
+        1.813 - no change
 
 */
 
@@ -193,10 +194,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
@@ -770,14 +783,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
@@ -1237,6 +1249,9 @@ SV *   sv ;
     }  
     dbp = RETVAL->dbp ;
 
+#ifdef WANT_ERROR
+           RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ;
+#endif
     if (sv)
     {
         if (! SvROK(sv) )
@@ -1431,6 +1446,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) ; 
@@ -1441,7 +1462,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) ;
@@ -1471,7 +1491,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() ;
  

diff --git a/ext/DB_File/t/db-recno.t b/ext/DB_File/t/db-recno.t
index 23bf0cd..26bae07 100755 (executable)
--- a/ext/DB_File/t/db-recno.t
+++ b/ext/DB_File/t/db-recno.t
@@ -522,7 +522,9 @@ EOM
     ok(86, $x eq "abc\ndef\nghi\njkl\n") ;
 
     # $# sets array to same length
-    ok(87, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
+    $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ;
+    ok(87, $self) 
+        or warn "# $DB_File::Error\n";
     if ($FA)
       { $#h = 3 }
     else