t/15_digest.t

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