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