DB_File 1.58 patch

p4raw-id: //depot/perl@506

3 files changed, 257 insertions, 27 deletions

diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes
new file mode 100644
index 0000000000..a86ea4a26d
--- /dev/null
+++ b/ext/DB_File/Changes
@@ -0,0 +1,194 @@
+
+0.1
+
+    First Release.
+
+0.2
+
+    When DB_File is opening a database file it no longer terminates the
+    process if dbopen returned an error. This allows file protection
+    errors to be caught at run time. Thanks to Judith Grass
+    <grass@cybercash.com> for spotting the bug.
+
+0.3
+
+    Added prototype support for multiple btree compare callbacks.
+
+1.0
+
+    DB_File has been in use for over a year. To reflect that, the
+    version number has been incremented to 1.0.
+
+    Added complete support for multiple concurrent callbacks.
+
+    Using the push method on an empty list didn't work properly. This
+    has been fixed.
+
+1.01
+
+    Fixed a core dump problem with SunOS.
+
+    The return value from TIEHASH wasn't set to NULL when dbopen
+    returned an error.
+
+1.02
+
+    Merged OS/2 specific code into DB_File.xs
+
+    Removed some redundant code in DB_File.xs.
+
+    Documentation update.
+
+    Allow negative subscripts with RECNO interface.
+
+    Changed the default flags from O_RDWR to O_CREAT|O_RDWR.
+
+    The example code which showed how to lock a database needed a call
+    to sync added. Without it the resultant database file was empty.
+
+    Added get_dup method.
+
+1.03
+
+    Documentation update.
+
+    DB_File now imports the constants (O_RDWR, O_CREAT etc.) from Fcntl
+    automatically.
+
+    The standard hash function exists is now supported.
+
+    Modified the behavior of get_dup. When it returns an associative
+    array, the value is the count of the number of matching BTREE
+    values.
+
+1.04
+
+    Minor documentation changes.
+
+    Fixed a bug in hash_cb. Patches supplied by Dave Hammen,
+    <hammen@gothamcity.jsc.nasa.govt>.
+
+    Fixed a bug with the constructors for DB_File::HASHINFO,
+    DB_File::BTREEINFO and DB_File::RECNOINFO. Also tidied up the
+    constructors to make them -w clean.
+
+    Reworked part of the test harness to be more locale friendly.
+
+1.05
+
+    Made all scripts in the documentation strict and -w clean.
+
+    Added logic to DB_File.xs to allow the module to be built after
+    Perl is installed.
+
+1.06
+
+    Minor namespace cleanup: Localized PrintBtree.
+
+1.07
+
+    Fixed bug with RECNO, where bval wasn't defaulting to "\n".
+
+1.08
+
+    Documented operation of bval.
+
+1.09
+
+    Minor bug fix in DB_File::HASHINFO, DB_File::RECNOINFO and
+    DB_File::BTREEINFO.
+
+    Changed default mode to 0666.
+
+1.10
+
+    Fixed fd method so that it still returns -1 for in-memory files
+    when db 1.86 is used.
+
+1.11
+
+    Documented the untie gotcha.
+
+1.12
+
+    Documented the incompatibility with version 2 of Berkeley DB.
+
+1.13
+
+    Minor changes to DB_FIle.xs and DB_File.pm
+
+1.14
+
+    Made it illegal to tie an associative array to a RECNO database and
+    an ordinary array to a HASH or BTREE database.
+
+1.15
+
+    Patch from Gisle Aas <gisle@aas.no> to suppress "use of undefined
+    value" warning with db_get and db_seq.
+
+    Patch from Gisle Aas <gisle@aas.no> to make DB_File export only the
+    O_* constants from Fcntl.
+
+    Removed the DESTROY method from the DB_File::HASHINFO module.
+
+    Previously DB_File hard-wired the class name of any object that it
+    created to "DB_File". This makes sub-classing difficult. Now
+    DB_File creats objects in the namespace of the package it has been
+    inherited into.
+
+
+1.16
+
+   A harmless looking tab was causing Makefile.PL to fail on AIX 3.2.5
+
+    Small fix for the AIX strict C compiler XLC which doesn't like
+    __attribute__ being defined via proto.h and redefined via db.h. Fix
+    courtesy of Jarkko Hietaniemi.
+
+1.50
+
+    DB_File can now build with either DB 1.x or 2.x, but not both at
+    the same time.
+
+1.51
+
+    Fixed the test harness so that it doesn't expect DB_File to have
+    been installed by the main Perl build.
+
+
+    Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
+
+1.52
+
+   Patch from Nick Ing-Simmons now allows DB_File to build on NT.
+   Merged 1.15 patch.
+
+1.53
+
+   Added DB_RENUMBER to flags for recno.
+
+1.54
+
+   Fixed a small bug in the test harness when run under win32
+   The emulation of fd when useing DB 2.x was busted.
+
+1.55
+   Merged 1.16 changes.
+
+1.56
+   Documented the Solaris 2.5 mutex bug
+
+1.57
+   If Perl has been compiled with Threads support,the symbol op will be
+   defined. This clashes with a field name in db.h, so it needs to be
+   #undef'ed before db.h is included.
+
+1.58
+   Tied Array support was enhanced in Perl 5.004_57. DB_File now
+   supports PUSH,POP,SHIFT,UNSHIFT & STORESIZE.
+
+   Fixed a problem with the use of sv_setpvn. When the size is
+   specified as 0, it does a strlen on the data.  This was ok for DB
+   1.x, but isn't for DB 2.x.
+
diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index 812464361a..95e0a5599f 100644
--- 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 (pmarquess@bfsec.bt.co.uk)
-# last modified 20th Nov 1997
-# version 1.56
+# last modified 20th Dec 1997
+# version 1.57
 #
 #     Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
@@ -106,7 +106,7 @@ package DB_File::RECNOINFO ;
 
 use strict ;
 
-@DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ;  
+@DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ;
 
 sub TIEHASH
 {
@@ -145,7 +145,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_ver
 use Carp;
 
 
-$VERSION = "1.56" ;
+$VERSION = "1.58" ;
 
 #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
 $DB_BTREE = new DB_File::BTREEINFO ;
@@ -189,9 +189,7 @@ require DynaLoader;
 	R_SNAPSHOT
 	__R_UNUSED
 
-);  
-
-*FETCHSIZE = \&length;
+);
 
 sub AUTOLOAD {
     my($constname);
@@ -267,7 +265,8 @@ sub TIEARRAY
     tie_hash_or_array(@_) ;
 }
 
-sub CLEAR {
+sub CLEAR 
+{
     my $self = shift;
     my $key = "" ;
     my $value = "" ;
@@ -283,6 +282,23 @@ sub CLEAR {
     }
 }
 
+sub EXTEND { }
+
+sub STORESIZE
+{
+    my $self = shift;
+    my $length = shift ;
+    my $current_length = $self->length() ;
+
+    if ($length < $current_length) {
+	my $key ;
+        for ($key = $current_length - 1 ; $key >= $length ; -- $key)
+	  { $self->del($key) }
+    }
+    elsif ($length > $current_length)
+        { $self->put($length-1, "") }
+}
+ 
 sub get_dup
 {
     croak "Usage: \$db->get_dup(key [,flag])\n"
@@ -1022,11 +1038,15 @@ Here is the output from the script:
 
 =head2 Extra Methods
 
-As you can see from the example above, the tied array interface is
-quite limited. To make the interface more useful, a number of methods
-are supplied with B<DB_File> to simulate the standard array operations
-that are not currently implemented in Perl's tied array interface. All
-these methods are accessed via the object returned from the tie call.
+If you are using a version of Perl earlier than 5.004_57, the tied
+array interface is quite limited. The example script above will work,
+but you won't be able to use C<push>, C<pop>, C<shift>, C<unshift>
+etc. with the tied array.
+
+To make the interface more useful for older versions of Perl, a number
+of methods are supplied with B<DB_File> to simulate the missing array
+operations. All these methods are accessed via the object returned from
+the tie call.
 
 Here are the methods:
 
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index 8f2eda10b0..91b4dc2ad5 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -3,12 +3,12 @@
  DB_File.xs -- Perl 5 interface to Berkeley DB 
 
  written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
- last modified 20th Nov 1997
- version 1.56
+ last modified 2nd Feb 1998
+ version 1.58
 
  All comments/suggestions/problems are welcome
 
-     Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved.
+     Copyright (c) 1995, 1996, 1997, 1998 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.
 
@@ -50,6 +50,10 @@
 	1.54 -  Fixed bug in the fd method
         1.55 -  Fix for AIX from Jarkko Hietaniemi
         1.56 -  No change to DB_File.xs
+        1.57 -  added the #undef op to allow building with Threads support.
+	1.58 -  Fixed a problem with the use of sv_setpvn. When the
+		size is specified as 0, it does a strlen on the data.
+		This was ok for DB 1.x, but isn't for DB 2.x.
 
 
 
@@ -65,6 +69,12 @@
 
 #undef __attribute__
 
+/* If Perl has been compiled with Threads support,the symbol op will
+   be defined here. This clashes with a field name in db.h, so get rid of it.
+ */
+#ifdef op
+#undef op
+#endif
 #include <db.h>
 
 #include <fcntl.h> 
@@ -238,10 +248,11 @@ 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 OutputValue(arg, name)  				\
 	{ if (RETVAL == 0) {					\
-	      sv_setpvn(arg, name.data, name.size) ;		\
+	      my_sv_setpvn(arg, name.data, name.size) ;		\
 	  }							\
 	}
 
@@ -249,13 +260,14 @@ typedef DBT DBTKEY ;
 	{ if (RETVAL == 0) 					\
 	  { 							\
 		if (db->type != DB_RECNO) {			\
-		    sv_setpvn(arg, name.data, name.size); 	\
+		    my_sv_setpvn(arg, name.data, name.size); 	\
 		}						\
 		else 						\
 		    sv_setiv(arg, (I32)*(I32*)name.data - 1); 	\
 	  } 							\
 	}
 
+
 /* Internal Global Data */
 static recno_t Value ; 
 static recno_t zero = 0 ;
@@ -560,13 +572,12 @@ SV *   sv ;
 {
     SV **	svp;
     HV *	action ;
-    DB_File	RETVAL;
+    DB_File	RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
     void *	openinfo = NULL ;
-    INFO	* info;
+    INFO	* info  = &RETVAL->info ;
 
 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
-    Newz(777, RETVAL, 1, DB_File_type) ;
-    info  = &RETVAL->info ;
+    Zero(RETVAL, 1, DB_File_type) ;
 
     /* Default to HASH */
     RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
@@ -1159,7 +1170,7 @@ db_FETCH(db, key, flags=0)
 	    RETVAL = db_get(db, key, value, flags) ;
 	    ST(0) = sv_newmortal();
 	    if (RETVAL == 0) 
-	        sv_setpvn(ST(0), value.data, value.size);
+	        my_sv_setpvn(ST(0), value.data, value.size);
 	}
 
 int
@@ -1189,7 +1200,7 @@ db_FIRSTKEY(db)
 	    if (RETVAL == 0)
 	    {
 	        if (db->type != DB_RECNO)
-	            sv_setpvn(ST(0), key.data, key.size);
+	            my_sv_setpvn(ST(0), key.data, key.size);
 	        else
 	            sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
 	    }
@@ -1211,7 +1222,7 @@ db_NEXTKEY(db, key)
 	    if (RETVAL == 0)
 	    {
 	        if (db->type != DB_RECNO)
-	            sv_setpvn(ST(0), key.data, key.size);
+	            my_sv_setpvn(ST(0), key.data, key.size);
 	        else
 	            sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
 	    }
@@ -1224,6 +1235,7 @@ db_NEXTKEY(db, key)
 int
 unshift(db, ...)
 	DB_File		db
+	ALIAS:		UNSHIFT = 1
 	CODE:
 	{
 	    DBTKEY	key ;
@@ -1264,6 +1276,7 @@ unshift(db, ...)
 I32
 pop(db)
 	DB_File		db
+	ALIAS:		POP = 1
 	CODE:
 	{
 	    DBTKEY	key ;
@@ -1281,7 +1294,7 @@ pop(db)
 	    if (RETVAL == 0)
 	    {
 		/* the call to del will trash value, so take a copy now */
-	        sv_setpvn(ST(0), value.data, value.size);
+	        my_sv_setpvn(ST(0), value.data, value.size);
 	        RETVAL = db_del(db, key, R_CURSOR) ;
 	        if (RETVAL != 0) 
 	            sv_setsv(ST(0), &sv_undef); 
@@ -1291,6 +1304,7 @@ pop(db)
 I32
 shift(db)
 	DB_File		db
+	ALIAS:		SHIFT = 1
 	CODE:
 	{
 	    DBT		value ;
@@ -1307,7 +1321,7 @@ shift(db)
 	    if (RETVAL == 0)
 	    {
 		/* the call to del will trash value, so take a copy now */
-	        sv_setpvn(ST(0), value.data, value.size);
+	        my_sv_setpvn(ST(0), value.data, value.size);
 	        RETVAL = db_del(db, key, R_CURSOR) ;
 	        if (RETVAL != 0)
 	            sv_setsv (ST(0), &sv_undef) ;
@@ -1318,6 +1332,7 @@ shift(db)
 I32
 push(db, ...)
 	DB_File		db
+	ALIAS:		PUSH = 1
 	CODE:
 	{
 	    DBTKEY	key ;
@@ -1365,6 +1380,7 @@ push(db, ...)
 I32
 length(db)
 	DB_File		db
+	ALIAS:		FETCHSIZE = 1
 	CODE:
 	    CurrentDB = db ;
 	    RETVAL = GetArrayLength(db) ;