1#!./perl -w 2 3use strict ; 4 5BEGIN { 6 unless(grep /blib/, @INC) { 7 chdir 't' if -d 't'; 8 @INC = '../lib' if -d '../lib'; 9 } 10} 11 12use lib 't'; 13use BerkeleyDB; 14use Test::More; 15use util; 16 17plan tests => 7; 18 19my $Dfile = "dbhash.tmp"; 20my $Dfile2 = "dbhash2.tmp"; 21my $Dfile3 = "dbhash3.tmp"; 22unlink $Dfile; 23 24umask(0) ; 25 26my $redirect = "xyzt" ; 27 28 29{ 30my $x = $BerkeleyDB::Error; 31my $redirect = "xyzt" ; 32 { 33 my $redirectObj = new Redirect $redirect ; 34 35 use strict ; 36 use BerkeleyDB ; 37 use vars qw( %h $k $v ) ; 38 39 my $filename = "fruit" ; 40 unlink $filename ; 41 tie %h, "BerkeleyDB::Hash", 42 -Filename => $filename, 43 -Flags => DB_CREATE 44 or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; 45 46 # Add a few key/value pairs to the file 47 $h{"apple"} = "red" ; 48 $h{"orange"} = "orange" ; 49 $h{"banana"} = "yellow" ; 50 $h{"tomato"} = "red" ; 51 52 # Check for existence of a key 53 print "Banana Exists\n\n" if $h{"banana"} ; 54 55 # Delete a key/value pair. 56 delete $h{"apple"} ; 57 58 # print the contents of the file 59 while (($k, $v) = each %h) 60 { print "$k -> $v\n" } 61 62 untie %h ; 63 unlink $filename ; 64 } 65 66 #print "[" . docat($redirect) . "]" ; 67 is(docat_del($redirect), <<'EOM') ; 68Banana Exists 69 70orange -> orange 71tomato -> red 72banana -> yellow 73EOM 74 75 76} 77 78{ 79my $redirect = "xyzt" ; 80 { 81 82 my $redirectObj = new Redirect $redirect ; 83 84 use strict ; 85 use BerkeleyDB ; 86 87 my $filename = "fruit" ; 88 unlink $filename ; 89 my $db = new BerkeleyDB::Hash 90 -Filename => $filename, 91 -Flags => DB_CREATE 92 or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; 93 94 # Add a few key/value pairs to the file 95 $db->db_put("apple", "red") ; 96 $db->db_put("orange", "orange") ; 97 $db->db_put("banana", "yellow") ; 98 $db->db_put("tomato", "red") ; 99 100 # Check for existence of a key 101 print "Banana Exists\n\n" if $db->db_get("banana", $v) == 0; 102 103 # Delete a key/value pair. 104 $db->db_del("apple") ; 105 106 # print the contents of the file 107 my ($k, $v) = ("", "") ; 108 my $cursor = $db->db_cursor() ; 109 while ($cursor->c_get($k, $v, DB_NEXT) == 0) 110 { print "$k -> $v\n" } 111 112 undef $cursor ; 113 undef $db ; 114 unlink $filename ; 115 } 116 117 #print "[" . docat($redirect) . "]" ; 118 is(docat_del($redirect), <<'EOM') ; 119Banana Exists 120 121orange -> orange 122tomato -> red 123banana -> yellow 124EOM 125 126} 127 128{ 129my $redirect = "xyzt" ; 130 { 131 132 my $redirectObj = new Redirect $redirect ; 133 134 use strict ; 135 use BerkeleyDB ; 136 137 my $filename = "tree" ; 138 unlink $filename ; 139 my %h ; 140 tie %h, 'BerkeleyDB::Btree', 141 -Filename => $filename, 142 -Flags => DB_CREATE 143 or die "Cannot open $filename: $! $BerkeleyDB::Error\n" ; 144 145 # Add a key/value pair to the file 146 $h{'Wall'} = 'Larry' ; 147 $h{'Smith'} = 'John' ; 148 $h{'mouse'} = 'mickey' ; 149 $h{'duck'} = 'donald' ; 150 151 # Delete 152 delete $h{"duck"} ; 153 154 # Cycle through the keys printing them in order. 155 # Note it is not necessary to sort the keys as 156 # the btree will have kept them in order automatically. 157 foreach (keys %h) 158 { print "$_\n" } 159 160 untie %h ; 161 unlink $filename ; 162 } 163 164 #print "[" . docat($redirect) . "]\n" ; 165 is(docat_del($redirect), <<'EOM') ; 166Smith 167Wall 168mouse 169EOM 170 171} 172 173{ 174my $redirect = "xyzt" ; 175 { 176 177 my $redirectObj = new Redirect $redirect ; 178 179 use strict ; 180 use BerkeleyDB ; 181 182 my $filename = "tree" ; 183 unlink $filename ; 184 my %h ; 185 tie %h, 'BerkeleyDB::Btree', 186 -Filename => $filename, 187 -Flags => DB_CREATE, 188 -Compare => sub { lc $_[0] cmp lc $_[1] } 189 or die "Cannot open $filename: $!\n" ; 190 191 # Add a key/value pair to the file 192 $h{'Wall'} = 'Larry' ; 193 $h{'Smith'} = 'John' ; 194 $h{'mouse'} = 'mickey' ; 195 $h{'duck'} = 'donald' ; 196 197 # Delete 198 delete $h{"duck"} ; 199 200 # Cycle through the keys printing them in order. 201 # Note it is not necessary to sort the keys as 202 # the btree will have kept them in order automatically. 203 foreach (keys %h) 204 { print "$_\n" } 205 206 untie %h ; 207 unlink $filename ; 208 } 209 210 #print "[" . docat($redirect) . "]\n" ; 211 is(docat_del($redirect), <<'EOM') ; 212mouse 213Smith 214Wall 215EOM 216 217} 218 219{ 220my $redirect = "xyzt" ; 221 { 222 223 my $redirectObj = new Redirect $redirect ; 224 225 use strict ; 226 use BerkeleyDB ; 227 228 my %hash ; 229 my $filename = "filt.db" ; 230 unlink $filename ; 231 232 my $db = tie %hash, 'BerkeleyDB::Hash', 233 -Filename => $filename, 234 -Flags => DB_CREATE 235 or die "Cannot open $filename: $!\n" ; 236 237 # Install DBM Filters 238 $db->filter_fetch_key ( sub { s/\0$// } ) ; 239 $db->filter_store_key ( sub { $_ .= "\0" } ) ; 240 $db->filter_fetch_value( sub { s/\0$// } ) ; 241 $db->filter_store_value( sub { $_ .= "\0" } ) ; 242 243 $hash{"abc"} = "def" ; 244 my $a = $hash{"ABC"} ; 245 # ... 246 undef $db ; 247 untie %hash ; 248 $db = tie %hash, 'BerkeleyDB::Hash', 249 -Filename => $filename, 250 -Flags => DB_CREATE 251 or die "Cannot open $filename: $!\n" ; 252 while (($k, $v) = each %hash) 253 { print "$k -> $v\n" } 254 undef $db ; 255 untie %hash ; 256 257 unlink $filename ; 258 } 259 260 #print "[" . docat($redirect) . "]\n" ; 261 is(docat_del($redirect), <<"EOM") ; 262abc\x00 -> def\x00 263EOM 264 265} 266 267{ 268my $redirect = "xyzt" ; 269 { 270 271 my $redirectObj = new Redirect $redirect ; 272 273 use strict ; 274 use BerkeleyDB ; 275 my %hash ; 276 my $filename = "filt.db" ; 277 unlink $filename ; 278 279 280 my $db = tie %hash, 'BerkeleyDB::Btree', 281 -Filename => $filename, 282 -Flags => DB_CREATE 283 or die "Cannot open $filename: $!\n" ; 284 285 $db->filter_fetch_key ( sub { $_ = unpack("i", $_) } ) ; 286 $db->filter_store_key ( sub { $_ = pack ("i", $_) } ) ; 287 $hash{123} = "def" ; 288 # ... 289 undef $db ; 290 untie %hash ; 291 $db = tie %hash, 'BerkeleyDB::Btree', 292 -Filename => $filename, 293 -Flags => DB_CREATE 294 or die "Cannot Open $filename: $!\n" ; 295 while (($k, $v) = each %hash) 296 { print "$k -> $v\n" } 297 undef $db ; 298 untie %hash ; 299 300 unlink $filename ; 301 } 302 303 my $val = pack("i", 123) ; 304 #print "[" . docat($redirect) . "]\n" ; 305 is(docat_del($redirect), <<"EOM") ; 306$val -> def 307EOM 308 309} 310 311{ 312my $redirect = "xyzt" ; 313 { 314 315 my $redirectObj = new Redirect $redirect ; 316 317 if ($FA) { 318 use strict ; 319 use BerkeleyDB ; 320 321 my $filename = "text" ; 322 unlink $filename ; 323 324 my @h ; 325 tie @h, 'BerkeleyDB::Recno', 326 -Filename => $filename, 327 -Flags => DB_CREATE, 328 -Property => DB_RENUMBER 329 or die "Cannot open $filename: $!\n" ; 330 331 # Add a few key/value pairs to the file 332 $h[0] = "orange" ; 333 $h[1] = "blue" ; 334 $h[2] = "yellow" ; 335 336 push @h, "green", "black" ; 337 338 my $elements = scalar @h ; 339 print "The array contains $elements entries\n" ; 340 341 my $last = pop @h ; 342 print "popped $last\n" ; 343 344 unshift @h, "white" ; 345 my $first = shift @h ; 346 print "shifted $first\n" ; 347 348 # Check for existence of a key 349 print "Element 1 Exists with value $h[1]\n" if $h[1] ; 350 351 untie @h ; 352 unlink $filename ; 353 } else { 354 use strict ; 355 use BerkeleyDB ; 356 357 my $filename = "text" ; 358 unlink $filename ; 359 360 my @h ; 361 my $db = tie @h, 'BerkeleyDB::Recno', 362 -Filename => $filename, 363 -Flags => DB_CREATE, 364 -Property => DB_RENUMBER 365 or die "Cannot open $filename: $!\n" ; 366 367 # Add a few key/value pairs to the file 368 $h[0] = "orange" ; 369 $h[1] = "blue" ; 370 $h[2] = "yellow" ; 371 372 $db->push("green", "black") ; 373 374 my $elements = $db->length() ; 375 print "The array contains $elements entries\n" ; 376 377 my $last = $db->pop ; 378 print "popped $last\n" ; 379 380 $db->unshift("white") ; 381 my $first = $db->shift ; 382 print "shifted $first\n" ; 383 384 # Check for existence of a key 385 print "Element 1 Exists with value $h[1]\n" if $h[1] ; 386 387 undef $db ; 388 untie @h ; 389 unlink $filename ; 390 } 391 392 } 393 394 #print "[" . docat($redirect) . "]\n" ; 395 is(docat_del($redirect), <<"EOM") ; 396The array contains 5 entries 397popped black 398shifted white 399Element 1 Exists with value blue 400EOM 401 402} 403 404