Import BSDDB 4.7.25 (as of svn r89086)
This commit is contained in:
Zachary Ware
403
perl/BerkeleyDB/t/examples.t
Normal file
403
perl/BerkeleyDB/t/examples.t
Normal file
@@ -0,0 +1,403 @@
|
||||
#!./perl -w
|
||||
|
||||
use strict ;
|
||||
|
||||
BEGIN {
|
||||
unless(grep /blib/, @INC) {
|
||||
chdir 't' if -d 't';
|
||||
@INC = '../lib' if -d '../lib';
|
||||
}
|
||||
}
|
||||
|
||||
use lib 't';
|
||||
use BerkeleyDB;
|
||||
use Test::More;
|
||||
use util(1);
|
||||
|
||||
plan tests => 7;
|
||||
|
||||
my $Dfile = "dbhash.tmp";
|
||||
my $Dfile2 = "dbhash2.tmp";
|
||||
my $Dfile3 = "dbhash3.tmp";
|
||||
unlink $Dfile;
|
||||
|
||||
umask(0) ;
|
||||
|
||||
my $redirect = "xyzt" ;
|
||||
|
||||
|
||||
{
|
||||
my $x = $BerkeleyDB::Error;
|
||||
my $redirect = "xyzt" ;
|
||||
{
|
||||
my $redirectObj = new Redirect $redirect ;
|
||||
|
||||
use strict ;
|
||||
use BerkeleyDB ;
|
||||
use vars qw( %h $k $v ) ;
|
||||
|
||||
my $filename = "fruit" ;
|
||||
unlink $filename ;
|
||||
tie %h, "BerkeleyDB::Hash",
|
||||
-Filename => $filename,
|
||||
-Flags => DB_CREATE
|
||||
or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ;
|
||||
|
||||
# Add a few key/value pairs to the file
|
||||
$h{"apple"} = "red" ;
|
||||
$h{"orange"} = "orange" ;
|
||||
$h{"banana"} = "yellow" ;
|
||||
$h{"tomato"} = "red" ;
|
||||
|
||||
# Check for existence of a key
|
||||
print "Banana Exists\n\n" if $h{"banana"} ;
|
||||
|
||||
# Delete a key/value pair.
|
||||
delete $h{"apple"} ;
|
||||
|
||||
# print the contents of the file
|
||||
while (($k, $v) = each %h)
|
||||
{ print "$k -> $v\n" }
|
||||
|
||||
untie %h ;
|
||||
unlink $filename ;
|
||||
}
|
||||
|
||||
#print "[" . docat($redirect) . "]" ;
|
||||
is(docat_del($redirect), <<'EOM') ;
|
||||
Banana Exists
|
||||
|
||||
orange -> orange
|
||||
tomato -> red
|
||||
banana -> yellow
|
||||
EOM
|
||||
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
my $redirect = "xyzt" ;
|
||||
{
|
||||
|
||||
my $redirectObj = new Redirect $redirect ;
|
||||
|
||||
use strict ;
|
||||
use BerkeleyDB ;
|
||||
|
||||
my $filename = "fruit" ;
|
||||
unlink $filename ;
|
||||
my $db = new BerkeleyDB::Hash
|
||||
-Filename => $filename,
|
||||
-Flags => DB_CREATE
|
||||
or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ;
|
||||
|
||||
# Add a few key/value pairs to the file
|
||||
$db->db_put("apple", "red") ;
|
||||
$db->db_put("orange", "orange") ;
|
||||
$db->db_put("banana", "yellow") ;
|
||||
$db->db_put("tomato", "red") ;
|
||||
|
||||
# Check for existence of a key
|
||||
print "Banana Exists\n\n" if $db->db_get("banana", $v) == 0;
|
||||
|
||||
# Delete a key/value pair.
|
||||
$db->db_del("apple") ;
|
||||
|
||||
# print the contents of the file
|
||||
my ($k, $v) = ("", "") ;
|
||||
my $cursor = $db->db_cursor() ;
|
||||
while ($cursor->c_get($k, $v, DB_NEXT) == 0)
|
||||
{ print "$k -> $v\n" }
|
||||
|
||||
undef $cursor ;
|
||||
undef $db ;
|
||||
unlink $filename ;
|
||||
}
|
||||
|
||||
#print "[" . docat($redirect) . "]" ;
|
||||
is(docat_del($redirect), <<'EOM') ;
|
||||
Banana Exists
|
||||
|
||||
orange -> orange
|
||||
tomato -> red
|
||||
banana -> yellow
|
||||
EOM
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
my $redirect = "xyzt" ;
|
||||
{
|
||||
|
||||
my $redirectObj = new Redirect $redirect ;
|
||||
|
||||
use strict ;
|
||||
use BerkeleyDB ;
|
||||
|
||||
my $filename = "tree" ;
|
||||
unlink $filename ;
|
||||
my %h ;
|
||||
tie %h, 'BerkeleyDB::Btree',
|
||||
-Filename => $filename,
|
||||
-Flags => DB_CREATE
|
||||
or die "Cannot open $filename: $! $BerkeleyDB::Error\n" ;
|
||||
|
||||
# Add a key/value pair to the file
|
||||
$h{'Wall'} = 'Larry' ;
|
||||
$h{'Smith'} = 'John' ;
|
||||
$h{'mouse'} = 'mickey' ;
|
||||
$h{'duck'} = 'donald' ;
|
||||
|
||||
# Delete
|
||||
delete $h{"duck"} ;
|
||||
|
||||
# Cycle through the keys printing them in order.
|
||||
# Note it is not necessary to sort the keys as
|
||||
# the btree will have kept them in order automatically.
|
||||
foreach (keys %h)
|
||||
{ print "$_\n" }
|
||||
|
||||
untie %h ;
|
||||
unlink $filename ;
|
||||
}
|
||||
|
||||
#print "[" . docat($redirect) . "]\n" ;
|
||||
is(docat_del($redirect), <<'EOM') ;
|
||||
Smith
|
||||
Wall
|
||||
mouse
|
||||
EOM
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
my $redirect = "xyzt" ;
|
||||
{
|
||||
|
||||
my $redirectObj = new Redirect $redirect ;
|
||||
|
||||
use strict ;
|
||||
use BerkeleyDB ;
|
||||
|
||||
my $filename = "tree" ;
|
||||
unlink $filename ;
|
||||
my %h ;
|
||||
tie %h, 'BerkeleyDB::Btree',
|
||||
-Filename => $filename,
|
||||
-Flags => DB_CREATE,
|
||||
-Compare => sub { lc $_[0] cmp lc $_[1] }
|
||||
or die "Cannot open $filename: $!\n" ;
|
||||
|
||||
# Add a key/value pair to the file
|
||||
$h{'Wall'} = 'Larry' ;
|
||||
$h{'Smith'} = 'John' ;
|
||||
$h{'mouse'} = 'mickey' ;
|
||||
$h{'duck'} = 'donald' ;
|
||||
|
||||
# Delete
|
||||
delete $h{"duck"} ;
|
||||
|
||||
# Cycle through the keys printing them in order.
|
||||
# Note it is not necessary to sort the keys as
|
||||
# the btree will have kept them in order automatically.
|
||||
foreach (keys %h)
|
||||
{ print "$_\n" }
|
||||
|
||||
untie %h ;
|
||||
unlink $filename ;
|
||||
}
|
||||
|
||||
#print "[" . docat($redirect) . "]\n" ;
|
||||
is(docat_del($redirect), <<'EOM') ;
|
||||
mouse
|
||||
Smith
|
||||
Wall
|
||||
EOM
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
my $redirect = "xyzt" ;
|
||||
{
|
||||
|
||||
my $redirectObj = new Redirect $redirect ;
|
||||
|
||||
use strict ;
|
||||
use BerkeleyDB ;
|
||||
|
||||
my %hash ;
|
||||
my $filename = "filt.db" ;
|
||||
unlink $filename ;
|
||||
|
||||
my $db = tie %hash, 'BerkeleyDB::Hash',
|
||||
-Filename => $filename,
|
||||
-Flags => DB_CREATE
|
||||
or die "Cannot open $filename: $!\n" ;
|
||||
|
||||
# Install DBM Filters
|
||||
$db->filter_fetch_key ( sub { s/\0$// } ) ;
|
||||
$db->filter_store_key ( sub { $_ .= "\0" } ) ;
|
||||
$db->filter_fetch_value( sub { s/\0$// } ) ;
|
||||
$db->filter_store_value( sub { $_ .= "\0" } ) ;
|
||||
|
||||
$hash{"abc"} = "def" ;
|
||||
my $a = $hash{"ABC"} ;
|
||||
# ...
|
||||
undef $db ;
|
||||
untie %hash ;
|
||||
$db = tie %hash, 'BerkeleyDB::Hash',
|
||||
-Filename => $filename,
|
||||
-Flags => DB_CREATE
|
||||
or die "Cannot open $filename: $!\n" ;
|
||||
while (($k, $v) = each %hash)
|
||||
{ print "$k -> $v\n" }
|
||||
undef $db ;
|
||||
untie %hash ;
|
||||
|
||||
unlink $filename ;
|
||||
}
|
||||
|
||||
#print "[" . docat($redirect) . "]\n" ;
|
||||
is(docat_del($redirect), <<"EOM") ;
|
||||
abc\x00 -> def\x00
|
||||
EOM
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
my $redirect = "xyzt" ;
|
||||
{
|
||||
|
||||
my $redirectObj = new Redirect $redirect ;
|
||||
|
||||
use strict ;
|
||||
use BerkeleyDB ;
|
||||
my %hash ;
|
||||
my $filename = "filt.db" ;
|
||||
unlink $filename ;
|
||||
|
||||
|
||||
my $db = tie %hash, 'BerkeleyDB::Btree',
|
||||
-Filename => $filename,
|
||||
-Flags => DB_CREATE
|
||||
or die "Cannot open $filename: $!\n" ;
|
||||
|
||||
$db->filter_fetch_key ( sub { $_ = unpack("i", $_) } ) ;
|
||||
$db->filter_store_key ( sub { $_ = pack ("i", $_) } ) ;
|
||||
$hash{123} = "def" ;
|
||||
# ...
|
||||
undef $db ;
|
||||
untie %hash ;
|
||||
$db = tie %hash, 'BerkeleyDB::Btree',
|
||||
-Filename => $filename,
|
||||
-Flags => DB_CREATE
|
||||
or die "Cannot Open $filename: $!\n" ;
|
||||
while (($k, $v) = each %hash)
|
||||
{ print "$k -> $v\n" }
|
||||
undef $db ;
|
||||
untie %hash ;
|
||||
|
||||
unlink $filename ;
|
||||
}
|
||||
|
||||
my $val = pack("i", 123) ;
|
||||
#print "[" . docat($redirect) . "]\n" ;
|
||||
is(docat_del($redirect), <<"EOM") ;
|
||||
$val -> def
|
||||
EOM
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
my $redirect = "xyzt" ;
|
||||
{
|
||||
|
||||
my $redirectObj = new Redirect $redirect ;
|
||||
|
||||
if ($FA) {
|
||||
use strict ;
|
||||
use BerkeleyDB ;
|
||||
|
||||
my $filename = "text" ;
|
||||
unlink $filename ;
|
||||
|
||||
my @h ;
|
||||
tie @h, 'BerkeleyDB::Recno',
|
||||
-Filename => $filename,
|
||||
-Flags => DB_CREATE,
|
||||
-Property => DB_RENUMBER
|
||||
or die "Cannot open $filename: $!\n" ;
|
||||
|
||||
# Add a few key/value pairs to the file
|
||||
$h[0] = "orange" ;
|
||||
$h[1] = "blue" ;
|
||||
$h[2] = "yellow" ;
|
||||
|
||||
push @h, "green", "black" ;
|
||||
|
||||
my $elements = scalar @h ;
|
||||
print "The array contains $elements entries\n" ;
|
||||
|
||||
my $last = pop @h ;
|
||||
print "popped $last\n" ;
|
||||
|
||||
unshift @h, "white" ;
|
||||
my $first = shift @h ;
|
||||
print "shifted $first\n" ;
|
||||
|
||||
# Check for existence of a key
|
||||
print "Element 1 Exists with value $h[1]\n" if $h[1] ;
|
||||
|
||||
untie @h ;
|
||||
unlink $filename ;
|
||||
} else {
|
||||
use strict ;
|
||||
use BerkeleyDB ;
|
||||
|
||||
my $filename = "text" ;
|
||||
unlink $filename ;
|
||||
|
||||
my @h ;
|
||||
my $db = tie @h, 'BerkeleyDB::Recno',
|
||||
-Filename => $filename,
|
||||
-Flags => DB_CREATE,
|
||||
-Property => DB_RENUMBER
|
||||
or die "Cannot open $filename: $!\n" ;
|
||||
|
||||
# Add a few key/value pairs to the file
|
||||
$h[0] = "orange" ;
|
||||
$h[1] = "blue" ;
|
||||
$h[2] = "yellow" ;
|
||||
|
||||
$db->push("green", "black") ;
|
||||
|
||||
my $elements = $db->length() ;
|
||||
print "The array contains $elements entries\n" ;
|
||||
|
||||
my $last = $db->pop ;
|
||||
print "popped $last\n" ;
|
||||
|
||||
$db->unshift("white") ;
|
||||
my $first = $db->shift ;
|
||||
print "shifted $first\n" ;
|
||||
|
||||
# Check for existence of a key
|
||||
print "Element 1 Exists with value $h[1]\n" if $h[1] ;
|
||||
|
||||
undef $db ;
|
||||
untie @h ;
|
||||
unlink $filename ;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#print "[" . docat($redirect) . "]\n" ;
|
||||
is(docat_del($redirect), <<"EOM") ;
|
||||
The array contains 5 entries
|
||||
popped black
|
||||
shifted white
|
||||
Element 1 Exists with value blue
|
||||
EOM
|
||||
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user