view release on metacpan or  search on metacpan

t/filter.t  view on Meta::CPAN

   eval { grep { $h{$_} } (1, 2, 3) };
   ok (! $@);

   undef $db ;
   untie %h;
   unlink $Dfile;
}

if(0)
{
    # Filter without tie
    use strict ;
    my (%h, $db) ;

    unlink $Dfile;
    ok $db = tie %h, 'BerkeleyDB::Hash',
    		-Filename   => $Dfile,
	        -Flags      => DB_CREATE;

    my %result = () ;

    sub INC { return ++ $_[0] }
    sub DEC { return -- $_[0] }
    #$db->filter_fetch_key   (sub { warn "FFK $_\n"; $_ = INC($_); warn "XX\n" }) ;
    #$db->filter_store_key   (sub { warn "FSK $_\n"; $_ = DEC($_); warn "XX\n" }) ;
    #$db->filter_fetch_value (sub { warn "FFV $_\n"; $_ = INC($_); warn "XX\n"}) ;
    #$db->filter_store_value (sub { warn "FSV $_\n"; $_ = DEC($_); warn "XX\n" }) ;

    $db->filter_fetch_key   (sub { warn "FFK $_\n"; $_ = pack("i", $_); warn "XX\n" }) ;
    $db->filter_store_key   (sub { warn "FSK $_\n"; $_ = unpack("i", $_); warn "XX\n" }) ;
    $db->filter_fetch_value (sub { warn "FFV $_\n"; $_ = pack("i", $_); warn "XX\n"}) ;
    #$db->filter_store_value (sub { warn "FSV $_\n"; $_ = unpack("i", $_); warn "XX\n" }) ;

    #$db->filter_fetch_key   (sub { ++ $_ }) ;
    #$db->filter_store_key   (sub { -- $_ }) ;
    #$db->filter_fetch_value (sub { ++ $_ }) ;
    #$db->filter_store_value (sub { -- $_ }) ;

    my ($k, $v) = (0,0);
    ok ! $db->db_put(3,5);
    exit;
    ok ! $db->db_get(3, $v);
    ok $v == 5 ;

    $h{4} = 7 ;
    ok $h{4} == 7;

    $k = 10;
    $v = 30;
    $h{$k} = $v ;
    ok $k == 10;
    ok $v == 30;
    ok $h{$k} == 30;

    $k = 3;
    ok ! $db->db_get($k, $v, DB_GET_BOTH);
    ok $k == 3 ;
    ok $v == 5 ;

    my $cursor = $db->db_cursor();

    my %tmp = ();
    while ($cursor->c_get($k, $v, DB_NEXT) == 0)
    {
	$tmp{$k} = $v;
    }

    ok keys %tmp == 3 ;
    ok $tmp{3} == 5;

    undef $cursor ;
    undef $db ;
    untie %h;
    unlink $Dfile;
}