view release on metacpan or  search on metacpan

t/hash.t  view on Meta::CPAN

    my $count = 0 ;
    # sequence forwards
    while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
        ++ $count ;
    }
    ok $count == 3 ;
    undef $cursor ;

    # now abort the transaction
    ok $txn->txn_abort() == 0 ;

    # there shouldn't be any records in the database
    $count = 0 ;
    # sequence forwards
    ok $cursor = $db1->db_cursor() ;
    while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
        ++ $count ;
    }
    ok $count == 0 ;

    undef $txn ;
    undef $cursor ;
    undef $db1 ;
    undef $env ;
    untie %hash ;
}


{
    # DB_DUP

    my $lex = new LexFile $Dfile ;
    my %hash ;
    ok my $db = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile,
				      -Property  => DB_DUP,
                                      -Flags    => DB_CREATE ;

    $hash{'Wall'} = 'Larry' ;
    $hash{'Wall'} = 'Stone' ;
    $hash{'Smith'} = 'John' ;
    $hash{'Wall'} = 'Brick' ;
    $hash{'Wall'} = 'Brick' ;
    $hash{'mouse'} = 'mickey' ;

    ok keys %hash == 6 ;

    # create a cursor
    ok my $cursor = $db->db_cursor() ;

    my $key = "Wall" ;
    my $value ;
    ok $cursor->c_get($key, $value, DB_SET) == 0 ;
    ok $key eq "Wall" && $value eq "Larry" ;
    ok $cursor->c_get($key, $value, DB_NEXT) == 0 ;
    ok $key eq "Wall" && $value eq "Stone" ;
    ok $cursor->c_get($key, $value, DB_NEXT) == 0 ;
    ok $key eq "Wall" && $value eq "Brick" ;
    ok $cursor->c_get($key, $value, DB_NEXT) == 0 ;
    ok $key eq "Wall" && $value eq "Brick" ;

    #my $ref = $db->db_stat() ;
    #ok $ref->{bt_flags} | DB_DUP ;

    # test DB_DUP_NEXT
    my ($k, $v) = ("Wall", "") ;
    ok $cursor->c_get($k, $v, DB_SET) == 0 ;
    ok $k eq "Wall" && $v eq "Larry" ;
    ok $cursor->c_get($k, $v, DB_NEXT_DUP) == 0 ;
    ok $k eq "Wall" && $v eq "Stone" ;
    ok $cursor->c_get($k, $v, DB_NEXT_DUP) == 0 ;
    ok $k eq "Wall" && $v eq "Brick" ;
    ok $cursor->c_get($k, $v, DB_NEXT_DUP) == 0 ;
    ok $k eq "Wall" && $v eq "Brick" ;
    ok $cursor->c_get($k, $v, DB_NEXT_DUP) == DB_NOTFOUND ;


    undef $db ;
    undef $cursor ;
    untie %hash ;

}

{
    # DB_DUP & DupCompare
    my $lex = new LexFile $Dfile, $Dfile2;
    my ($key, $value) ;
    my (%h, %g) ;
    my @Keys   = qw( 0123 9 12 -1234 9 987654321 9 def  ) ;
    my @Values = qw( 1    11 3   dd   x abc      2 0    ) ;

    ok tie %h, "BerkeleyDB::Hash", -Filename => $Dfile,
				     -DupCompare   => sub { $_[0] cmp $_[1] },
				     -Property  => DB_DUP|DB_DUPSORT,
				     -Flags    => DB_CREATE ;

    ok tie %g, 'BerkeleyDB::Hash', -Filename => $Dfile2,
				     -DupCompare   => sub { $_[0] <=> $_[1] },
				     -Property  => DB_DUP|DB_DUPSORT,
				     -Flags    => DB_CREATE ;

    foreach (@Keys) {
        local $^W = 0 ;
	my $value = shift @Values ;
        $h{$_} = $value ;
        $g{$_} = $value ;
    }

    ok my $cursor = (tied %h)->db_cursor() ;
    $key = 9 ; $value = "";
    ok $cursor->c_get($key, $value, DB_SET) == 0 ;
    ok $key == 9 && $value eq 11 ;
    ok $cursor->c_get($key, $value, DB_NEXT) == 0 ;
    ok $key == 9 && $value == 2 ;
    ok $cursor->c_get($key, $value, DB_NEXT) == 0 ;
    ok $key == 9 && $value eq "x" ;

    $cursor = (tied %g)->db_cursor() ;
    $key = 9 ;
    ok $cursor->c_get($key, $value, DB_SET) == 0 ;
    ok $key == 9 && $value eq "x" ;
    ok $cursor->c_get($key, $value, DB_NEXT) == 0 ;