1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
use strict;
use warnings FATAL => 'all';
use Test::More;
use t::common qw( new_dbm );
use_ok( 'DBM::Deep' );
my $salt = 38473827;
# Warning: This digest function is for testing ONLY.
# It is NOT intended for actual use. If you do so, I will laugh at you.
sub my_digest {
my $key = shift;
my $num = $salt;
for (my $k=0; $k<length($key); $k++) {
$num += ord( substr($key, $k, 1) );
}
return sprintf("%00000008d", $num);
}
my $dbm_factory = new_dbm( digest => \&my_digest, hash_size => 8 );
while ( my $dbm_maker = $dbm_factory->() ) {
my $db = $dbm_maker->();
##
# put/get key
##
$db->{key1} = "value1";
ok( $db->{key1} eq "value1" );
$db->put("key2", "value2");
ok( $db->get("key2") eq "value2" );
##
# key exists
##
ok( $db->exists("key1") );
ok( exists $db->{key2} );
##
# count keys
##
ok( scalar keys %$db == 2 );
##
# step through keys
##
my $temphash = {};
while ( my ($key, $value) = each %$db ) {
$temphash->{$key} = $value;
}
ok( ($temphash->{key1} eq "value1") && ($temphash->{key2} eq "value2") );
$temphash = {};
my $key = $db->first_key();
while ($key) {
$temphash->{$key} = $db->get($key);
$key = $db->next_key($key);
}
ok( ($temphash->{key1} eq "value1") && ($temphash->{key2} eq "value2") );
##
# delete keys
##
ok( delete $db->{key1} );
ok( $db->delete("key2") );
ok( scalar keys %$db == 0 );
##
# delete all keys
##
$db->put("another", "value");
$db->clear();
ok( scalar keys %$db == 0 );
##
# replace key
##
$db->put("key1", "value1");
$db->put("key1", "value2");
ok( $db->get("key1") eq "value2" );
$db->put("key1", "value222222222222222222222222");
ok( $db->get("key1") eq "value222222222222222222222222" );
}
done_testing;
|
