From: Paul Marquess Date: Wed, 30 Apr 1997 20:45:09 +0000 (+0100) Subject: Refresh DB_File to 1.14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=05475680fbb0187887aec733f8c78c90733ace24;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 ;