1#!./perl -w 2 3use strict ; 4 5use lib 't' ; 6use BerkeleyDB; 7use Test::More ; 8use util qw(1); 9 10plan(skip_all => "this needs Berkeley DB 3.x or better\n" ) 11 if $BerkeleyDB::db_version < 3; 12 13plan tests => 43; 14 15my $Dfile = "dbhash.tmp"; 16my $Dfile2 = "dbhash2.tmp"; 17my $Dfile3 = "dbhash3.tmp"; 18unlink $Dfile; 19 20umask(0) ; 21 22sub countDatabases 23{ 24 my $file = shift ; 25 26 ok my $db = new BerkeleyDB::Unknown -Filename => $file , 27 -Flags => DB_RDONLY ; 28 29 #my $type = $db->type() ; print "type $type\n" ; 30 ok my $cursor = $db->db_cursor() ; 31 my ($k, $v) = ("", "") ; 32 my $status ; 33 my @dbnames = () ; 34 while (($status = $cursor->c_get($k, $v, DB_NEXT)) == 0) { 35 push @dbnames, $k ; 36 } 37 38 ok $status == DB_NOTFOUND; 39 40 return wantarray ? sort @dbnames : scalar @dbnames ; 41 42 43} 44 45# Berkeley DB 3.x specific functionality 46 47# Check for invalid parameters 48{ 49 # Check for invalid parameters 50 my $db ; 51 eval ' BerkeleyDB::db_remove -Stupid => 3 ; ' ; 52 ok $@ =~ /unknown key value\(s\) Stupid/ ; 53 54 eval ' BerkeleyDB::db_remove -Bad => 2, -Filename => "fred", -Stupid => 3; ' ; 55 ok $@ =~ /unknown key value\(s\) (Bad,? |Stupid,? ){2}/ ; 56 57 eval ' BerkeleyDB::db_remove -Filename => "a", -Env => 2 ' ; 58 ok $@ =~ /^Env not of type BerkeleyDB::Env/ ; 59 60 eval ' BerkeleyDB::db_remove -Subname => "a"' ; 61 ok $@ =~ /^Must specify a filename/ ; 62 63 my $obj = bless [], "main" ; 64 eval ' BerkeleyDB::db_remove -Filename => "x", -Env => $obj ' ; 65 ok $@ =~ /^Env not of type BerkeleyDB::Env/ ; 66} 67 68{ 69 # subdatabases 70 71 # opening a subdatabse in an exsiting database that doesn't have 72 # subdatabases at all should fail 73 74 my $lex = new LexFile $Dfile ; 75 76 ok my $db = new BerkeleyDB::Hash -Filename => $Dfile, 77 -Flags => DB_CREATE ; 78 79 # Add a k/v pair 80 my %data = qw( 81 red sky 82 blue sea 83 black heart 84 yellow belley 85 green grass 86 ) ; 87 88 ok addData($db, %data) ; 89 90 undef $db ; 91 92 $db = new BerkeleyDB::Hash -Filename => $Dfile, 93 -Subname => "fred" ; 94 ok ! $db ; 95 96 ok -e $Dfile ; 97 ok ! BerkeleyDB::db_remove(-Filename => $Dfile) ; 98} 99 100{ 101 # subdatabases 102 103 # opening a subdatabse in an exsiting database that does have 104 # subdatabases at all, but not this one 105 106 my $lex = new LexFile $Dfile ; 107 108 ok my $db = new BerkeleyDB::Hash -Filename => $Dfile, 109 -Subname => "fred" , 110 -Flags => DB_CREATE ; 111 112 # Add a k/v pair 113 my %data = qw( 114 red sky 115 blue sea 116 black heart 117 yellow belley 118 green grass 119 ) ; 120 121 ok addData($db, %data) ; 122 123 undef $db ; 124 125 $db = new BerkeleyDB::Hash -Filename => $Dfile, 126 -Subname => "joe" ; 127 128 ok !$db ; 129 130} 131 132{ 133 # subdatabases 134 135 my $lex = new LexFile $Dfile ; 136 137 ok my $db = new BerkeleyDB::Hash -Filename => $Dfile, 138 -Subname => "fred" , 139 -Flags => DB_CREATE ; 140 141 # Add a k/v pair 142 my %data = qw( 143 red sky 144 blue sea 145 black heart 146 yellow belley 147 green grass 148 ) ; 149 150 ok addData($db, %data) ; 151 undef $db ; 152 153 is join(",", countDatabases($Dfile)), "fred"; 154 155} 156 157{ 158 # subdatabases 159 160 # opening a database with multiple subdatabases - handle should be a list 161 # of the subdatabase names 162 163 my $lex = new LexFile $Dfile ; 164 165 ok my $db1 = new BerkeleyDB::Hash -Filename => $Dfile, 166 -Subname => "fred" , 167 -Flags => DB_CREATE ; 168 169 ok my $db2 = new BerkeleyDB::Btree -Filename => $Dfile, 170 -Subname => "joe" , 171 -Flags => DB_CREATE ; 172 173 # Add a k/v pair 174 my %data = qw( 175 red sky 176 blue sea 177 black heart 178 yellow belley 179 green grass 180 ) ; 181 182 ok addData($db1, %data) ; 183 ok addData($db2, %data) ; 184 185 undef $db1 ; 186 undef $db2 ; 187 188 is join(",", countDatabases($Dfile)), "fred,joe"; 189 190 ok BerkeleyDB::db_remove(-Filename => $Dfile, -Subname => "harry") != 0; 191 ok BerkeleyDB::db_remove(-Filename => $Dfile, -Subname => "fred") == 0 ; 192 193 # should only be one subdatabase 194 is join(",", countDatabases($Dfile)), "joe"; 195 196 # can't delete an already deleted subdatabase 197 ok BerkeleyDB::db_remove(-Filename => $Dfile, -Subname => "fred") != 0; 198 199 ok BerkeleyDB::db_remove(-Filename => $Dfile, -Subname => "joe") == 0 ; 200 201 # should only be one subdatabase 202 is countDatabases($Dfile), 0; 203 204 ok -e $Dfile ; 205 ok BerkeleyDB::db_remove(-Filename => $Dfile) == 0 ; 206 ok ! -e $Dfile ; 207 ok BerkeleyDB::db_remove(-Filename => $Dfile) != 0 ; 208} 209 210# db_remove with env 211