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

diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index 65928aa..2d5e744 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 (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 cd9f1d1..8d01d91 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 (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 8975485..c90c9d7 100755 (executable)
--- 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 9765e2e..471ee02 100755 (executable)
--- 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 5df5af1..338edd0 100755 (executable)
--- 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 ;