1#!./perl -w 2 3use strict ; 4 5use lib 't'; 6use util (1); 7 8use Test::More ; 9 10use BerkeleyDB; 11 12plan(skip_all => "1..0 # Skip: this needs Berkeley DB 3.1.x or better\n") 13 if $BerkeleyDB::db_version < 3.1 ; 14 15plan(tests => 48) ; 16 17 18my $Dfile = "dbhash.tmp"; 19my $Dfile2 = "dbhash2.tmp"; 20my $Dfile3 = "dbhash3.tmp"; 21unlink $Dfile; 22 23umask(0) ; 24 25 26 27{ 28 title "c_count"; 29 30 my $lex = new LexFile $Dfile ; 31 my %hash ; 32 my $db = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, 33 -Property => DB_DUP, 34 -Flags => DB_CREATE ; 35 ok $db, " open database ok"; 36 37 $hash{'Wall'} = 'Larry' ; 38 $hash{'Wall'} = 'Stone' ; 39 $hash{'Smith'} = 'John' ; 40 $hash{'Wall'} = 'Brick' ; 41 $hash{'Wall'} = 'Brick' ; 42 $hash{'mouse'} = 'mickey' ; 43 44 is keys %hash, 6, " keys == 6" ; 45 46 # create a cursor 47 my $cursor = $db->db_cursor() ; 48 ok $cursor, " created cursor"; 49 50 my $key = "Wall" ; 51 my $value ; 52 cmp_ok $cursor->c_get($key, $value, DB_SET), '==', 0, " c_get ok" ; 53 is $key, "Wall", " key is 'Wall'"; 54 is $value, "Larry", " value is 'Larry'"; ; 55 56 my $count ; 57 cmp_ok $cursor->c_count($count), '==', 0, " c_count ok" ; 58 is $count, 4, " count is 4" ; 59 60 $key = "Smith" ; 61 cmp_ok $cursor->c_get($key, $value, DB_SET), '==', 0, " c_get ok" ; 62 is $key, "Smith", " key is 'Smith'"; 63 is $value, "John", " value is 'John'"; ; 64 65 cmp_ok $cursor->c_count($count), '==', 0, " c_count ok" ; 66 is $count, 1, " count is 1" ; 67 68 69 undef $db ; 70 undef $cursor ; 71 untie %hash ; 72 73} 74 75{ 76 title "db_key_range"; 77 78 my $lex = new LexFile $Dfile ; 79 my %hash ; 80 my $db = tie %hash, 'BerkeleyDB::Btree', -Filename => $Dfile, 81 -Property => DB_DUP, 82 -Flags => DB_CREATE ; 83 isa_ok $db, 'BerkeleyDB::Btree', " create database ok"; 84 85 $hash{'Wall'} = 'Larry' ; 86 $hash{'Wall'} = 'Stone' ; 87 $hash{'Smith'} = 'John' ; 88 $hash{'Wall'} = 'Brick' ; 89 $hash{'Wall'} = 'Brick' ; 90 $hash{'mouse'} = 'mickey' ; 91 92 is keys %hash, 6, " 6 keys" ; 93 94 my $key = "Wall" ; 95 my ($less, $equal, $greater) ; 96 cmp_ok $db->db_key_range($key, $less, $equal, $greater), '==', 0, " db_key_range ok" ; 97 98 cmp_ok $less, '!=', 0 ; 99 cmp_ok $equal, '!=', 0 ; 100 cmp_ok $greater, '!=', 0 ; 101 102 $key = "Smith" ; 103 cmp_ok $db->db_key_range($key, $less, $equal, $greater), '==', 0, " db_key_range ok" ; 104 105 cmp_ok $less, '==', 0 ; 106 cmp_ok $equal, '!=', 0 ; 107 cmp_ok $greater, '!=', 0 ; 108 109 $key = "NotThere" ; 110 cmp_ok $db->db_key_range($key, $less, $equal, $greater), '==', 0, " db_key_range ok" ; 111 112 cmp_ok $less, '==', 0 ; 113 cmp_ok $equal, '==', 0 ; 114 cmp_ok $greater, '==', 1 ; 115 116 undef $db ; 117 untie %hash ; 118 119} 120 121{ 122 title "rename a subdb"; 123 124 my $lex = new LexFile $Dfile ; 125 126 my $db1 = new BerkeleyDB::Hash -Filename => $Dfile, 127 -Subname => "fred" , 128 -Flags => DB_CREATE ; 129 isa_ok $db1, 'BerkeleyDB::Hash', " create database ok"; 130 131 my $db2 = new BerkeleyDB::Btree -Filename => $Dfile, 132 -Subname => "joe" , 133 -Flags => DB_CREATE ; 134 isa_ok $db2, 'BerkeleyDB::Btree', " create database ok"; 135 136 # Add a k/v pair 137 my %data = qw( 138 red sky 139 blue sea 140 black heart 141 yellow belley 142 green grass 143 ) ; 144 145 ok addData($db1, %data), " added to db1 ok" ; 146 ok addData($db2, %data), " added to db2 ok" ; 147 148 undef $db1 ; 149 undef $db2 ; 150 151 # now rename 152 cmp_ok BerkeleyDB::db_rename(-Filename => $Dfile, 153 -Subname => "fred", 154 -Newname => "harry"), '==', 0, " rename ok"; 155 156 my $db3 = new BerkeleyDB::Hash -Filename => $Dfile, 157 -Subname => "harry" ; 158 isa_ok $db3, 'BerkeleyDB::Hash', " verify rename"; 159 160} 161 162{ 163 title "rename a file"; 164 165 my $lex = new LexFile $Dfile, $Dfile2 ; 166 167 my $db1 = new BerkeleyDB::Hash -Filename => $Dfile, 168 -Subname => "fred" , 169 -Flags => DB_CREATE; 170 isa_ok $db1, 'BerkeleyDB::Hash', " create database ok"; 171 172 my $db2 = new BerkeleyDB::Hash -Filename => $Dfile, 173 -Subname => "joe" , 174 -Flags => DB_CREATE ; 175 isa_ok $db2, 'BerkeleyDB::Hash', " create database ok"; 176 177 # Add a k/v pair 178 my %data = qw( 179 red sky 180 blue sea 181 black heart 182 yellow belley 183 green grass 184 ) ; 185 186 ok addData($db1, %data), " add data to db1" ; 187 ok addData($db2, %data), " add data to db2" ; 188 189 undef $db1 ; 190 undef $db2 ; 191 192 # now rename 193 cmp_ok BerkeleyDB::db_rename(-Filename => $Dfile, -Newname => $Dfile2), 194 '==', 0, " rename file to $Dfile2 ok"; 195 196 my $db3 = new BerkeleyDB::Hash -Filename => $Dfile2, 197 -Subname => "fred" ; 198 isa_ok $db3, 'BerkeleyDB::Hash', " verify rename" 199 or diag "$! $BerkeleyDB::Error"; 200 201 202# TODO add rename with no subname & txn 203} 204 205{ 206 title "verify"; 207 208 my $lex = new LexFile $Dfile, $Dfile2 ; 209 210 my $db1 = new BerkeleyDB::Hash -Filename => $Dfile, 211 -Subname => "fred" , 212 -Flags => DB_CREATE ; 213 isa_ok $db1, 'BerkeleyDB::Hash', " create database ok"; 214 215 # Add a k/v pair 216 my %data = qw( 217 red sky 218 blue sea 219 black heart 220 yellow belley 221 green grass 222 ) ; 223 224 ok addData($db1, %data), " added data ok" ; 225 226 undef $db1 ; 227 228 # now verify 229 cmp_ok BerkeleyDB::db_verify(-Filename => $Dfile, 230 -Subname => "fred", 231 ), '==', 0, " verify ok"; 232 233 # now verify & dump 234 cmp_ok BerkeleyDB::db_verify(-Filename => $Dfile, 235 -Subname => "fred", 236 -Outfile => $Dfile2, 237 ), '==', 0, " verify and dump ok"; 238 239} 240 241# db_remove with env 242 243