Refresh DB_File to 1.14

Something for _99.

Made it illegal to tie an associative array to a RECNO database and an
ordinary array to a HASH or BTREE database.

p5p-msgid: 9704302045.AA05484@claudius.bfsec.bt.co.uk

5 files changed, 78 insertions, 20 deletions

diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index 65928aaa48..2d5e744671 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 27th Apr 1997
-# version 1.13
+# last modified 30th Apr 1997
+# version 1.14
 #
 #     Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
@@ -146,7 +146,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO) ;
 use Carp;
 
 
-$VERSION = "1.13" ;
+$VERSION = "1.14" ;
 
 #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
 $DB_BTREE = new DB_File::BTREEINFO ;
@@ -229,17 +229,26 @@ bootstrap DB_File $VERSION;
 # Preloaded methods go here.  Autoload methods go after __END__, and are
 # processed by the autosplit program.
 
-sub TIEHASH
+sub tie_hash_or_array
 {
     my (@arg) = @_ ;
+    my $tieHASH = ( (caller(1))[3] =~ /TIEHASH/ ) ;
 
     $arg[4] = tied %{ $arg[4] } 
 	if @arg >= 5 && ref $arg[4] && $arg[4] =~ /=HASH/ && tied %{ $arg[4] } ;
 
-    DoTie_(@arg) ;
+    DoTie_($tieHASH, @arg) ;
 }
 
-*TIEARRAY = \&TIEHASH ;
+sub TIEHASH
+{
+    tie_hash_or_array(@_) ;
+}
+
+sub TIEARRAY
+{
+    tie_hash_or_array(@_) ;
+}
 
 sub get_dup
 {
@@ -1652,6 +1661,11 @@ Documented the incompatibility with version 2 of Berkeley DB.
 
 Minor changes to DB_FIle.xs and DB_File.pm
 
+=item 1.14
+
+Made it illegal to tie an associative array to a RECNO database and an
+ordinary array to a HASH or BTREE database.
+
 =back
 
 =head1 BUGS
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index cd9f1d1ab7..8d01d91642 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 (pmarquess@bfsec.bt.co.uk)
- last modified 27th Apr 1997
- version 1.13
+ last modified 30th Apr 1997
+ version 1.14
 
  All comments/suggestions/problems are welcome
 
@@ -40,6 +40,8 @@
 	1.11 -  No change to DB_File.xs
 	1.12 -  No change to DB_File.xs
 	1.13 -  Tidied up a few casts.
+	1.14 -  Made it illegal to tie an associative array to a RECNO
+	        database and an ordinary array to a HASH or BTREE database.
 
 */
 
@@ -352,7 +354,8 @@ I32      value ;
 }
 
 static DB_File
-ParseOpenInfo(name, flags, mode, sv)
+ParseOpenInfo(isHASH, name, flags, mode, sv)
+int    isHASH ;
 char * name ;
 int    flags ;
 int    mode ;
@@ -387,6 +390,10 @@ SV *   sv ;
 
         if (sv_isa(sv, "DB_File::HASHINFO"))
         {
+
+	    if (!isHASH)
+	        croak("DB_File can only tie an associative array to a DB_HASH database") ;
+
             RETVAL->type = DB_HASH ;
             openinfo = (void*)info ;
   
@@ -419,6 +426,9 @@ SV *   sv ;
         }
         else if (sv_isa(sv, "DB_File::BTREEINFO"))
         {
+	    if (!isHASH)
+	        croak("DB_File can only tie an associative array to a DB_BTREE database");
+
             RETVAL->type = DB_BTREE ;
             openinfo = (void*)info ;
    
@@ -463,6 +473,9 @@ SV *   sv ;
         }
         else if (sv_isa(sv, "DB_File::RECNOINFO"))
         {
+	    if (isHASH)
+	        croak("DB_File can only tie an array to a DB_RECNO database");
+
             RETVAL->type = DB_RECNO ;
             openinfo = (void *)info ;
 
@@ -780,7 +793,8 @@ constant(name,arg)
 
 
 DB_File
-db_DoTie_(dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
+db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
+	int		isHASH
 	char *		dbtype
 	int		flags
 	int		mode
@@ -789,13 +803,13 @@ db_DoTie_(dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
 	    char *	name = (char *) NULL ; 
 	    SV *	sv = (SV *) NULL ; 
 
-	    if (items >= 2 && SvOK(ST(1))) 
-	        name = (char*) SvPV(ST(1), na) ; 
+	    if (items >= 3 && SvOK(ST(2))) 
+	        name = (char*) SvPV(ST(2), na) ; 
 
-            if (items == 5)
-	        sv = ST(4) ;
+            if (items == 6)
+	        sv = ST(5) ;
 
-	    RETVAL = ParseOpenInfo(name, flags, mode, sv) ;
+	    RETVAL = ParseOpenInfo(isHASH, name, flags, mode, sv) ;
 	    if (RETVAL->dbp == NULL)
 	        RETVAL = NULL ;
 	}
@@ -880,7 +894,7 @@ db_FIRSTKEY(db)
 	    ST(0) = sv_newmortal();
 	    if (RETVAL == 0)
 	    {
-	        if (Db->type != DB_RECNO)
+	        if (db->type != DB_RECNO)
 	            sv_setpvn(ST(0), key.data, key.size);
 	        else
 	            sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
@@ -901,7 +915,7 @@ db_NEXTKEY(db, key)
 	    ST(0) = sv_newmortal();
 	    if (RETVAL == 0)
 	    {
-	        if (Db->type != DB_RECNO)
+	        if (db->type != DB_RECNO)
 	            sv_setpvn(ST(0), key.data, key.size);
 	        else
 	            sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t
index 897548585b..c90c9d7d98 100755
--- a/t/lib/db-btree.t
+++ b/t/lib/db-btree.t
@@ -12,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 
-print "1..91\n";
+print "1..92\n";
 
 sub ok
 {
@@ -503,4 +503,14 @@ ok(91, $i == 0);
 untie %h ;
 unlink $Dfile1 ;
 
+{
+    # check that attempting to tie an array to a DB_BTREE will fail
+
+    my $filename = "xyz" ;
+    my @x ;
+    eval { tie @x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE ; } ;
+    ok(92, $@ =~ /^DB_File can only tie an associative array to a DB_BTREE database/) ;
+    unlink $filename ;
+}
+
 exit ;
diff --git a/t/lib/db-hash.t b/t/lib/db-hash.t
index 9765e2ed86..471ee0283b 100755
--- a/t/lib/db-hash.t
+++ b/t/lib/db-hash.t
@@ -12,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 
-print "1..51\n";
+print "1..52\n";
 
 sub ok
 {
@@ -310,4 +310,14 @@ untie %h ;
     ok(51, $::count >0) ;
 }
 
+{
+    # check that attempting to tie an array to a DB_HASH will fail
+
+    my $filename = "xyz" ;
+    my @x ;
+    eval { tie @x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_HASH ; } ;
+    ok(52, $@ =~ /^DB_File can only tie an associative array to a DB_HASH database/) ;
+    unlink $filename ;
+}
+
 exit ;
diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t
index 5df5af1808..338edd0db5 100755
--- a/t/lib/db-recno.t
+++ b/t/lib/db-recno.t
@@ -41,7 +41,7 @@ sub bad_one
 EOM
 }
 
-print "1..55\n";
+print "1..56\n";
 
 my $Dfile = "recno.tmp";
 unlink $Dfile ;
@@ -270,4 +270,14 @@ unlink $Dfile;
     ok(55, $ok) ;
 }
 
+{
+    # check that attempting to tie an associative array to a DB_RECNO will fail
+
+    my $filename = "xyz" ;
+    my %x ;
+    eval { tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_RECNO ; } ;
+    ok(56, $@ =~ /^DB_File can only tie an array to a DB_RECNO database/) ;
+    unlink $filename ;
+}
+
 exit ;