Finished most of the renamings and updated Changes to reflect the new API
[dbsrgits/DBM-Deep.git] / t / 15_digest.t
1 ##
2 # DBM::Deep Test
3 ##
4 use strict;
5 use Test;
6 BEGIN { plan tests => 13 }
7
8 use DBM::Deep;
9
10 my $salt = 38473827;
11
12 ##
13 # basic file open
14 ##
15 unlink "t/test.db";
16 my $db = new DBM::Deep(
17         file => "t/test.db"
18 );
19 if ($db->error()) {
20         die "ERROR: " . $db->error();
21 }
22
23 ##
24 # Set digest handler
25 ##
26 DBM::Deep::set_digest( \&my_digest, 8 );
27
28 ##
29 # put/get key
30 ##
31 $db->{key1} = "value1";
32 ok( $db->{key1} eq "value1" );
33
34 $db->put("key2", "value2");
35 ok( $db->get("key2") eq "value2" );
36
37 ##
38 # key exists
39 ##
40 ok( $db->exists("key1") );
41 ok( exists $db->{key2} );
42
43 ##
44 # count keys
45 ##
46 ok( scalar keys %$db == 2 );
47
48 ##
49 # step through keys
50 ##
51 my $temphash = {};
52 while ( my ($key, $value) = each %$db ) {
53         $temphash->{$key} = $value;
54 }
55
56 ok( ($temphash->{key1} eq "value1") && ($temphash->{key2} eq "value2") );
57
58 $temphash = {};
59 my $key = $db->first_key();
60 while ($key) {
61         $temphash->{$key} = $db->get($key);
62         $key = $db->next_key($key);
63 }
64
65 ok( ($temphash->{key1} eq "value1") && ($temphash->{key2} eq "value2") );
66
67 ##
68 # delete keys
69 ##
70 ok( delete $db->{key1} );
71 ok( $db->delete("key2") );
72
73 ok( scalar keys %$db == 0 );
74
75 ##
76 # delete all keys
77 ##
78 $db->put("another", "value");
79 $db->clear();
80
81 ok( scalar keys %$db == 0 );
82
83 ##
84 # replace key
85 ##
86 $db->put("key1", "value1");
87 $db->put("key1", "value2");
88
89 ok( $db->get("key1") eq "value2" );
90
91 $db->put("key1", "value222222222222222222222222");
92
93 ok( $db->get("key1") eq "value222222222222222222222222" );
94
95 ##
96 # close, delete file, exit
97 ##
98 undef $db;
99 unlink "t/test.db";
100 exit(0);
101
102 sub my_digest {
103         ##
104         # Warning: This digest function is for testing ONLY
105         # It is NOT intended for actual use
106         ##
107         my $key = shift;
108         my $num = $salt;
109         
110         for (my $k=0; $k<length($key); $k++) {
111                 $num += ord( substr($key, $k, 1) );
112         }
113         
114         return sprintf("%00000008d", $num);
115 }