1#!./perl -w 2 3 4use strict ; 5 6 7use lib 't' ; 8use BerkeleyDB; 9use util ; 10 11BEGIN 12{ 13 if ($BerkeleyDB::db_version < 3.3) { 14 print "1..0 # Skip: this needs Berkeley DB 3.3.x or better\n" ; 15 exit 0 ; 16 } 17} 18 19umask(0); 20 21print "1..130\n"; 22 23{ 24 # db->truncate 25 26 my $Dfile; 27 my $lex = new LexFile $Dfile ; 28 my %hash ; 29 my ($k, $v) ; 30 ok 1, my $db = new BerkeleyDB::Hash -Filename => $Dfile, 31 -Flags => DB_CREATE ; 32 33 # create some data 34 my %data = ( 35 "red" => 2, 36 "green" => "house", 37 "blue" => "sea", 38 ) ; 39 40 my $ret = 0 ; 41 while (($k, $v) = each %data) { 42 $ret += $db->db_put($k, $v) ; 43 } 44 ok 2, $ret == 0 ; 45 46 # check there are three records 47 ok 3, countRecords($db) == 3 ; 48 49 # now truncate the database 50 my $count = 0; 51 ok 4, $db->truncate($count) == 0 ; 52 53 ok 5, $count == 3 ; 54 ok 6, countRecords($db) == 0 ; 55 56} 57 58{ 59 # db->associate -- secondary keys 60 61 sub sec_key 62 { 63 #print "in sec_key\n"; 64 my $pkey = shift ; 65 my $pdata = shift ; 66 67 $_[0] = $pdata ; 68 return 0; 69 } 70 71 my ($Dfile1, $Dfile2); 72 my $lex = new LexFile $Dfile1, $Dfile2 ; 73 my %hash ; 74 my $status; 75 my ($k, $v, $pk) = ('','',''); 76 77 # create primary database 78 ok 7, my $primary = new BerkeleyDB::Hash -Filename => $Dfile1, 79 -Flags => DB_CREATE ; 80 81 # create secondary database 82 ok 8, my $secondary = new BerkeleyDB::Hash -Filename => $Dfile2, 83 -Flags => DB_CREATE ; 84 85 # associate primary with secondary 86 ok 9, $primary->associate($secondary, \&sec_key) == 0; 87 88 # add data to the primary 89 my %data = ( 90 "red" => "flag", 91 "green" => "house", 92 "blue" => "sea", 93 ) ; 94 95 my $ret = 0 ; 96 while (($k, $v) = each %data) { 97 my $r = $primary->db_put($k, $v) ; 98 #print "put $r $BerkeleyDB::Error\n"; 99 $ret += $r; 100 } 101 ok 10, $ret == 0 ; 102 103 # check the records in the secondary 104 ok 11, countRecords($secondary) == 3 ; 105 106 ok 12, $secondary->db_get("house", $v) == 0; 107 ok 13, $v eq "house"; 108 109 ok 14, $secondary->db_get("sea", $v) == 0; 110 ok 15, $v eq "sea"; 111 112 ok 16, $secondary->db_get("flag", $v) == 0; 113 ok 17, $v eq "flag"; 114 115 # pget to primary database is illegal 116 ok 18, $primary->db_pget('red', $pk, $v) != 0 ; 117 118 # pget to secondary database is ok 119 ok 19, $secondary->db_pget('house', $pk, $v) == 0 ; 120 ok 20, $pk eq 'green'; 121 ok 21, $v eq 'house'; 122 123 ok 22, my $p_cursor = $primary->db_cursor(); 124 ok 23, my $s_cursor = $secondary->db_cursor(); 125 126 # c_get from primary 127 $k = 'green'; 128 ok 24, $p_cursor->c_get($k, $v, DB_SET) == 0; 129 ok 25, $k eq 'green'; 130 ok 26, $v eq 'house'; 131 132 # c_get from secondary 133 $k = 'sea'; 134 ok 27, $s_cursor->c_get($k, $v, DB_SET) == 0; 135 ok 28, $k eq 'sea'; 136 ok 29, $v eq 'sea'; 137 138 # c_pget from primary database should fail 139 $k = 1; 140 ok 30, $p_cursor->c_pget($k, $pk, $v, DB_FIRST) != 0; 141 142 # c_pget from secondary database 143 $k = 'flag'; 144 ok 31, $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0; 145 ok 32, $k eq 'flag'; 146 ok 33, $pk eq 'red'; 147 ok 34, $v eq 'flag'; 148 149 # check put to secondary is illegal 150 ok 35, $secondary->db_put("tom", "dick") != 0; 151 ok 36, countRecords($secondary) == 3 ; 152 153 # delete from primary 154 ok 37, $primary->db_del("green") == 0 ; 155 ok 38, countRecords($primary) == 2 ; 156 157 # check has been deleted in secondary 158 ok 39, $secondary->db_get("house", $v) != 0; 159 ok 40, countRecords($secondary) == 2 ; 160 161 # delete from secondary 162 ok 41, $secondary->db_del('flag') == 0 ; 163 ok 42, countRecords($secondary) == 1 ; 164 165 166 # check deleted from primary 167 ok 43, $primary->db_get("red", $v) != 0; 168 ok 44, countRecords($primary) == 1 ; 169 170} 171 172 173 # db->associate -- multiple secondary keys 174 175 176 # db->associate -- same again but when DB_DUP is specified. 177 178 179{ 180 # db->associate -- secondary keys, each with a user defined sort 181 182 sub sec_key2 183 { 184 my $pkey = shift ; 185 my $pdata = shift ; 186 #print "in sec_key2 [$pkey][$pdata]\n"; 187 188 $_[0] = length $pdata ; 189 return 0; 190 } 191 192 my ($Dfile1, $Dfile2); 193 my $lex = new LexFile $Dfile1, $Dfile2 ; 194 my %hash ; 195 my $status; 196 my ($k, $v, $pk) = ('','',''); 197 198 # create primary database 199 ok 45, my $primary = new BerkeleyDB::Btree -Filename => $Dfile1, 200 -Compare => sub { return $_[0] cmp $_[1]}, 201 -Flags => DB_CREATE ; 202 203 # create secondary database 204 ok 46, my $secondary = new BerkeleyDB::Btree -Filename => $Dfile2, 205 -Compare => sub { return $_[0] <=> $_[1]}, 206 -Property => DB_DUP, 207 -Flags => DB_CREATE ; 208 209 # associate primary with secondary 210 ok 47, $primary->associate($secondary, \&sec_key2) == 0; 211 212 # add data to the primary 213 my %data = ( 214 "red" => "flag", 215 "orange"=> "custard", 216 "green" => "house", 217 "blue" => "sea", 218 ) ; 219 220 my $ret = 0 ; 221 while (($k, $v) = each %data) { 222 my $r = $primary->db_put($k, $v) ; 223 #print "put [$r] $BerkeleyDB::Error\n"; 224 $ret += $r; 225 } 226 ok 48, $ret == 0 ; 227 #print "ret $ret\n"; 228 229 #print "Primary\n" ; dumpdb($primary) ; 230 #print "Secondary\n" ; dumpdb($secondary) ; 231 232 # check the records in the secondary 233 ok 49, countRecords($secondary) == 4 ; 234 235 my $p_data = joinkeys($primary, " "); 236 #print "primary [$p_data]\n" ; 237 ok 50, $p_data eq join " ", sort { $a cmp $b } keys %data ; 238 my $s_data = joinkeys($secondary, " "); 239 #print "secondary [$s_data]\n" ; 240 ok 51, $s_data eq join " ", sort { $a <=> $b } map { length } values %data ; 241 242} 243 244{ 245 # db->associate -- primary recno, secondary hash 246 247 sub sec_key3 248 { 249 #print "in sec_key\n"; 250 my $pkey = shift ; 251 my $pdata = shift ; 252 253 $_[0] = $pdata ; 254 return 0; 255 } 256 257 my ($Dfile1, $Dfile2); 258 my $lex = new LexFile $Dfile1, $Dfile2 ; 259 my %hash ; 260 my $status; 261 my ($k, $v, $pk) = ('','',''); 262 263 # create primary database 264 ok 52, my $primary = new BerkeleyDB::Recno -Filename => $Dfile1, 265 -Flags => DB_CREATE ; 266 267 # create secondary database 268 ok 53, my $secondary = new BerkeleyDB::Hash -Filename => $Dfile2, 269 -Flags => DB_CREATE ; 270 271 # associate primary with secondary 272 ok 54, $primary->associate($secondary, \&sec_key3) == 0; 273 274 # add data to the primary 275 my %data = ( 276 0 => "flag", 277 1 => "house", 278 2 => "sea", 279 ) ; 280 281 my $ret = 0 ; 282 while (($k, $v) = each %data) { 283 my $r = $primary->db_put($k, $v) ; 284 #print "put $r $BerkeleyDB::Error\n"; 285 $ret += $r; 286 } 287 ok 55, $ret == 0 ; 288 289 # check the records in the secondary 290 ok 56, countRecords($secondary) == 3 ; 291 292 ok 57, $secondary->db_get("flag", $v) == 0; 293 ok 58, $v eq "flag"; 294 295 ok 59, $secondary->db_get("house", $v) == 0; 296 ok 60, $v eq "house"; 297 298 ok 61, $secondary->db_get("sea", $v) == 0; 299 ok 62, $v eq "sea" ; 300 301 # pget to primary database is illegal 302 ok 63, $primary->db_pget(0, $pk, $v) != 0 ; 303 304 # pget to secondary database is ok 305 ok 64, $secondary->db_pget('house', $pk, $v) == 0 ; 306 ok 65, $pk == 1 ; 307 ok 66, $v eq 'house'; 308 309 ok 67, my $p_cursor = $primary->db_cursor(); 310 ok 68, my $s_cursor = $secondary->db_cursor(); 311 312 # c_get from primary 313 $k = 1; 314 ok 69, $p_cursor->c_get($k, $v, DB_SET) == 0; 315 ok 70, $k == 1; 316 ok 71, $v eq 'house'; 317 318 # c_get from secondary 319 $k = 'sea'; 320 ok 72, $s_cursor->c_get($k, $v, DB_SET) == 0; 321 ok 73, $k eq 'sea' 322 or warn "# key [$k]\n"; 323 ok 74, $v eq 'sea'; 324 325 # c_pget from primary database should fail 326 $k = 1; 327 ok 75, $p_cursor->c_pget($k, $pk, $v, DB_FIRST) != 0; 328 329 # c_pget from secondary database 330 $k = 'sea'; 331 ok 76, $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0; 332 ok 77, $k eq 'sea' ; 333 ok 78, $pk == 2 ; 334 ok 79, $v eq 'sea'; 335 336 # check put to secondary is illegal 337 ok 80, $secondary->db_put("tom", "dick") != 0; 338 ok 81, countRecords($secondary) == 3 ; 339 340 # delete from primary 341 ok 82, $primary->db_del(2) == 0 ; 342 ok 83, countRecords($primary) == 2 ; 343 344 # check has been deleted in secondary 345 ok 84, $secondary->db_get("sea", $v) != 0; 346 ok 85, countRecords($secondary) == 2 ; 347 348 # delete from secondary 349 ok 86, $secondary->db_del('flag') == 0 ; 350 ok 87, countRecords($secondary) == 1 ; 351 352 353 # check deleted from primary 354 ok 88, $primary->db_get(0, $v) != 0; 355 ok 89, countRecords($primary) == 1 ; 356 357} 358 359{ 360 # db->associate -- primary hash, secondary recno 361 362 sub sec_key4 363 { 364 #print "in sec_key4\n"; 365 my $pkey = shift ; 366 my $pdata = shift ; 367 368 $_[0] = length $pdata ; 369 return 0; 370 } 371 372 my ($Dfile1, $Dfile2); 373 my $lex = new LexFile $Dfile1, $Dfile2 ; 374 my %hash ; 375 my $status; 376 my ($k, $v, $pk) = ('','',''); 377 378 # create primary database 379 ok 90, my $primary = new BerkeleyDB::Hash -Filename => $Dfile1, 380 -Flags => DB_CREATE ; 381 382 # create secondary database 383 ok 91, my $secondary = new BerkeleyDB::Recno -Filename => $Dfile2, 384 #-Property => DB_DUP, 385 -Flags => DB_CREATE ; 386 387 # associate primary with secondary 388 ok 92, $primary->associate($secondary, \&sec_key4) == 0; 389 390 # add data to the primary 391 my %data = ( 392 "red" => "flag", 393 "green" => "house", 394 "blue" => "sea", 395 ) ; 396 397 my $ret = 0 ; 398 while (($k, $v) = each %data) { 399 my $r = $primary->db_put($k, $v) ; 400 #print "put $r $BerkeleyDB::Error\n"; 401 $ret += $r; 402 } 403 ok 93, $ret == 0 ; 404 405 # check the records in the secondary 406 ok 94, countRecords($secondary) == 3 ; 407 408 ok 95, $secondary->db_get(0, $v) != 0; 409 ok 96, $secondary->db_get(1, $v) != 0; 410 ok 97, $secondary->db_get(2, $v) != 0; 411 ok 98, $secondary->db_get(3, $v) == 0; 412 ok 99, $v eq "sea"; 413 414 ok 100, $secondary->db_get(4, $v) == 0; 415 ok 101, $v eq "flag"; 416 417 ok 102, $secondary->db_get(5, $v) == 0; 418 ok 103, $v eq "house"; 419 420 # pget to primary database is illegal 421 ok 104, $primary->db_pget(0, $pk, $v) != 0 ; 422 423 # pget to secondary database is ok 424 ok 105, $secondary->db_pget(4, $pk, $v) == 0 ; 425 ok 106, $pk eq 'red' 426 or warn "# $pk\n";; 427 ok 107, $v eq 'flag'; 428 429 ok 108, my $p_cursor = $primary->db_cursor(); 430 ok 109, my $s_cursor = $secondary->db_cursor(); 431 432 # c_get from primary 433 $k = 'green'; 434 ok 110, $p_cursor->c_get($k, $v, DB_SET) == 0; 435 ok 111, $k eq 'green'; 436 ok 112, $v eq 'house'; 437 438 # c_get from secondary 439 $k = 3; 440 ok 113, $s_cursor->c_get($k, $v, DB_SET) == 0; 441 ok 114, $k == 3 ; 442 ok 115, $v eq 'sea'; 443 444 # c_pget from primary database should fail 445 $k = 1; 446 ok 116, $p_cursor->c_pget($k, $pk, $v, DB_SET) != 0; 447 448 # c_pget from secondary database 449 $k = 5; 450 ok 117, $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0; 451 ok 118, $k == 5 ; 452 ok 119, $pk eq 'green'; 453 ok 120, $v eq 'house'; 454 455 # check put to secondary is illegal 456 ok 121, $secondary->db_put(77, "dick") != 0; 457 ok 122, countRecords($secondary) == 3 ; 458 459 # delete from primary 460 ok 123, $primary->db_del("green") == 0 ; 461 ok 124, countRecords($primary) == 2 ; 462 463 # check has been deleted in secondary 464 ok 125, $secondary->db_get(5, $v) != 0; 465 ok 126, countRecords($secondary) == 2 ; 466 467 # delete from secondary 468 ok 127, $secondary->db_del(4) == 0 ; 469 ok 128, countRecords($secondary) == 1 ; 470 471 472 # check deleted from primary 473 ok 129, $primary->db_get("red", $v) != 0; 474 ok 130, countRecords($primary) == 1 ; 475 476} 477