#!./perl -w
use strict ;
use lib 't' ;
use BerkeleyDB;
use util ;
BEGIN
{
if ($BerkeleyDB::db_version < 3.3) {
print "1..0 # Skip: this needs Berkeley DB 3.3.x or better\n" ;
exit 0 ;
}
}
umask(0);
print "1..130\n";
{
# db->truncate
my $Dfile;
my $lex = new LexFile $Dfile ;
my %hash ;
my ($k, $v) ;
ok 1, my $db = new BerkeleyDB::Hash -Filename => $Dfile,
-Flags => DB_CREATE ;
# create some data
my %data = (
"red" => 2,
"green" => "house",
"blue" => "sea",
) ;
my $ret = 0 ;
while (($k, $v) = each %data) {
$ret += $db->db_put($k, $v) ;
}
ok 2, $ret == 0 ;
# check there are three records
ok 3, countRecords($db) == 3 ;
# now truncate the database
my $count = 0;
ok 4, $db->truncate($count) == 0 ;
ok 5, $count == 3 ;
ok 6, countRecords($db) == 0 ;
}
{
# db->associate -- secondary keys
sub sec_key
{
#print "in sec_key\n";
my $pkey = shift ;
my $pdata = shift ;
$_[0] = $pdata ;
return 0;
}
my ($Dfile1, $Dfile2);
my $lex = new LexFile $Dfile1, $Dfile2 ;
my %hash ;
my $status;
my ($k, $v, $pk) = ('','','');
# create primary database
ok 7, my $primary = new BerkeleyDB::Hash -Filename => $Dfile1,
-Flags => DB_CREATE ;
# create secondary database
ok 8, my $secondary = new BerkeleyDB::Hash -Filename => $Dfile2,
-Flags => DB_CREATE ;
# associate primary with secondary
ok 9, $primary->associate($secondary, \&sec_key) == 0;
# add data to the primary
my %data = (
"red" => "flag",
"green" => "house",
"blue" => "sea",
) ;
my $ret = 0 ;
while (($k, $v) = each %data) {
my $r = $primary->db_put($k, $v) ;
#print "put $r $BerkeleyDB::Error\n";
$ret += $r;
}
ok 10, $ret == 0 ;
# check the records in the secondary
ok 11, countRecords($secondary) == 3 ;
ok 12, $secondary->db_get("house", $v) == 0;
ok 13, $v eq "house";
ok 14, $secondary->db_get("sea", $v) == 0;
ok 15, $v eq "sea";
ok 16, $secondary->db_get("flag", $v) == 0;
ok 17, $v eq "flag";
# pget to primary database is illegal
ok 18, $primary->db_pget('red', $pk, $v) != 0 ;
# pget to secondary database is ok
ok 19, $secondary->db_pget('house', $pk, $v) == 0 ;
ok 20, $pk eq 'green';
ok 21, $v eq 'house';
ok 22, my $p_cursor = $primary->db_cursor();
ok 23, my $s_cursor = $secondary->db_cursor();
# c_get from primary
$k = 'green';
ok 24, $p_cursor->c_get($k, $v, DB_SET) == 0;
ok 25, $k eq 'green';
ok 26, $v eq 'house';
# c_get from secondary
$k = 'sea';
ok 27, $s_cursor->c_get($k, $v, DB_SET) == 0;
ok 28, $k eq 'sea';
ok 29, $v eq 'sea';
# c_pget from primary database should fail
$k = 1;
ok 30, $p_cursor->c_pget($k, $pk, $v, DB_FIRST) != 0;
# c_pget from secondary database
$k = 'flag';
ok 31, $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0;
ok 32, $k eq 'flag';
ok 33, $pk eq 'red';
ok 34, $v eq 'flag';
# check put to secondary is illegal
ok 35, $secondary->db_put("tom", "dick") != 0;
ok 36, countRecords($secondary) == 3 ;
# delete from primary
ok 37, $primary->db_del("green") == 0 ;
ok 38, countRecords($primary) == 2 ;
# check has been deleted in secondary
ok 39, $secondary->db_get("house", $v) != 0;
ok 40, countRecords($secondary) == 2 ;
# delete from secondary
ok 41, $secondary->db_del('flag') == 0 ;
ok 42, countRecords($secondary) == 1 ;
# check deleted from primary
ok 43, $primary->db_get("red", $v) != 0;
ok 44, countRecords($primary) == 1 ;
}
# db->associate -- multiple secondary keys
# db->associate -- same again but when DB_DUP is specified.
{
# db->associate -- secondary keys, each with a user defined sort
sub sec_key2
{
my $pkey = shift ;
my $pdata = shift ;
#print "in sec_key2 [$pkey][$pdata]\n";
$_[0] = length $pdata ;
return 0;
}
my ($Dfile1, $Dfile2);
my $lex = new LexFile $Dfile1, $Dfile2 ;
my %hash ;
my $status;
my ($k, $v, $pk) = ('','','');
# create primary database
ok 45, my $primary = new BerkeleyDB::Btree -Filename => $Dfile1,
-Compare => sub { return $_[0] cmp $_[1]},
-Flags => DB_CREATE ;
# create secondary database
ok 46, my $secondary = new BerkeleyDB::Btree -Filename => $Dfile2,
-Compare => sub { return $_[0] <=> $_[1]},
-Property => DB_DUP,
-Flags => DB_CREATE ;
# associate primary with secondary
ok 47, $primary->associate($secondary, \&sec_key2) == 0;
# add data to the primary
my %data = (
"red" => "flag",
"orange"=> "custard",
"green" => "house",
"blue" => "sea",
) ;
my $ret = 0 ;
while (($k, $v) = each %data) {
my $r = $primary->db_put($k, $v) ;
#print "put [$r] $BerkeleyDB::Error\n";
$ret += $r;
}
ok 48, $ret == 0 ;
#print "ret $ret\n";
#print "Primary\n" ; dumpdb($primary) ;
#print "Secondary\n" ; dumpdb($secondary) ;
# check the records in the secondary
ok 49, countRecords($secondary) == 4 ;
my $p_data = joinkeys($primary, " ");
#print "primary [$p_data]\n" ;
ok 50, $p_data eq join " ", sort { $a cmp $b } keys %data ;
my $s_data = joinkeys($secondary, " ");
#print "secondary [$s_data]\n" ;
ok 51, $s_data eq join " ", sort { $a <=> $b } map { length } values %data ;
}
{
# db->associate -- primary recno, secondary hash
sub sec_key3
{
#print "in sec_key\n";
my $pkey = shift ;
my $pdata = shift ;
$_[0] = $pdata ;
return 0;
}
my ($Dfile1, $Dfile2);
my $lex = new LexFile $Dfile1, $Dfile2 ;
my %hash ;
my $status;
my ($k, $v, $pk) = ('','','');
# create primary database
ok 52, my $primary = new BerkeleyDB::Recno -Filename => $Dfile1,
-Flags => DB_CREATE ;
# create secondary database
ok 53, my $secondary = new BerkeleyDB::Hash -Filename => $Dfile2,
-Flags => DB_CREATE ;
# associate primary with secondary
ok 54, $primary->associate($secondary, \&sec_key3) == 0;
# add data to the primary
my %data = (
0 => "flag",
1 => "house",
2 => "sea",
) ;
my $ret = 0 ;
while (($k, $v) = each %data) {
my $r = $primary->db_put($k, $v) ;
#print "put $r $BerkeleyDB::Error\n";
$ret += $r;
}
ok 55, $ret == 0 ;
# check the records in the secondary
ok 56, countRecords($secondary) == 3 ;
ok 57, $secondary->db_get("flag", $v) == 0;
ok 58, $v eq "flag";
ok 59, $secondary->db_get("house", $v) == 0;
ok 60, $v eq "house";
ok 61, $secondary->db_get("sea", $v) == 0;
ok 62, $v eq "sea" ;
# pget to primary database is illegal
ok 63, $primary->db_pget(0, $pk, $v) != 0 ;
# pget to secondary database is ok
ok 64, $secondary->db_pget('house', $pk, $v) == 0 ;
ok 65, $pk == 1 ;
ok 66, $v eq 'house';
ok 67, my $p_cursor = $primary->db_cursor();
ok 68, my $s_cursor = $secondary->db_cursor();
# c_get from primary
$k = 1;
ok 69, $p_cursor->c_get($k, $v, DB_SET) == 0;
ok 70, $k == 1;
ok 71, $v eq 'house';
# c_get from secondary
$k = 'sea';
ok 72, $s_cursor->c_get($k, $v, DB_SET) == 0;
ok 73, $k eq 'sea'
or warn "# key [$k]\n";
ok 74, $v eq 'sea';
# c_pget from primary database should fail
$k = 1;
ok 75, $p_cursor->c_pget($k, $pk, $v, DB_FIRST) != 0;
# c_pget from secondary database
$k = 'sea';
ok 76, $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0;
ok 77, $k eq 'sea' ;
ok 78, $pk == 2 ;
ok 79, $v eq 'sea';
# check put to secondary is illegal
ok 80, $secondary->db_put("tom", "dick") != 0;
ok 81, countRecords($secondary) == 3 ;
# delete from primary
ok 82, $primary->db_del(2) == 0 ;
ok 83, countRecords($primary) == 2 ;
# check has been deleted in secondary
ok 84, $secondary->db_get("sea", $v) != 0;
ok 85, countRecords($secondary) == 2 ;
# delete from secondary
ok 86, $secondary->db_del('flag') == 0 ;
ok 87, countRecords($secondary) == 1 ;
# check deleted from primary
ok 88, $primary->db_get(0, $v) != 0;
ok 89, countRecords($primary) == 1 ;
}
{
# db->associate -- primary hash, secondary recno
sub sec_key4
{
#print "in sec_key4\n";
my $pkey = shift ;
my $pdata = shift ;
$_[0] = length $pdata ;
return 0;
}
my ($Dfile1, $Dfile2);
my $lex = new LexFile $Dfile1, $Dfile2 ;
my %hash ;
my $status;
my ($k, $v, $pk) = ('','','');
# create primary database
ok 90, my $primary = new BerkeleyDB::Hash -Filename => $Dfile1,
-Flags => DB_CREATE ;
# create secondary database
ok 91, my $secondary = new BerkeleyDB::Recno -Filename => $Dfile2,
#-Property => DB_DUP,
-Flags => DB_CREATE ;
# associate primary with secondary
ok 92, $primary->associate($secondary, \&sec_key4) == 0;
# add data to the primary
my %data = (
"red" => "flag",
"green" => "house",
"blue" => "sea",
) ;
my $ret = 0 ;
while (($k, $v) = each %data) {
my $r = $primary->db_put($k, $v) ;
#print "put $r $BerkeleyDB::Error\n";
$ret += $r;
}
ok 93, $ret == 0 ;
# check the records in the secondary
ok 94, countRecords($secondary) == 3 ;
ok 95, $secondary->db_get(0, $v) != 0;
ok 96, $secondary->db_get(1, $v) != 0;
ok 97, $secondary->db_get(2, $v) != 0;
ok 98, $secondary->db_get(3, $v) == 0;
ok 99, $v eq "sea";
ok 100, $secondary->db_get(4, $v) == 0;
ok 101, $v eq "flag";
ok 102, $secondary->db_get(5, $v) == 0;
ok 103, $v eq "house";
# pget to primary database is illegal
ok 104, $primary->db_pget(0, $pk, $v) != 0 ;
# pget to secondary database is ok
ok 105, $secondary->db_pget(4, $pk, $v) == 0 ;
ok 106, $pk eq 'red'
or warn "# $pk\n";;
ok 107, $v eq 'flag';
ok 108, my $p_cursor = $primary->db_cursor();
ok 109, my $s_cursor = $secondary->db_cursor();
# c_get from primary
$k = 'green';
ok 110, $p_cursor->c_get($k, $v, DB_SET) == 0;
ok 111, $k eq 'green';
ok 112, $v eq 'house';
# c_get from secondary
$k = 3;
ok 113, $s_cursor->c_get($k, $v, DB_SET) == 0;
ok 114, $k == 3 ;
ok 115, $v eq 'sea';
# c_pget from primary database should fail
$k = 1;
ok 116, $p_cursor->c_pget($k, $pk, $v, DB_SET) != 0;
# c_pget from secondary database
$k = 5;
ok 117, $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0;
ok 118, $k == 5 ;
ok 119, $pk eq 'green';
ok 120, $v eq 'house';
# check put to secondary is illegal
ok 121, $secondary->db_put(77, "dick") != 0;
ok 122, countRecords($secondary) == 3 ;
# delete from primary
ok 123, $primary->db_del("green") == 0 ;
ok 124, countRecords($primary) == 2 ;
# check has been deleted in secondary
ok 125, $secondary->db_get(5, $v) != 0;
ok 126, countRecords($secondary) == 2 ;
# delete from secondary
ok 127, $secondary->db_del(4) == 0 ;
ok 128, countRecords($secondary) == 1 ;
# check deleted from primary
ok 129, $primary->db_get("red", $v) != 0;
ok 130, countRecords($primary) == 1 ;
}