t/15_digest.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3
   4 use Test::More;
   5 use t::common qw( new_dbm );
   6
   7 use_ok( 'DBM::Deep' );
   8
   9 my $salt = 38473827;
  10
  11 # Warning: This digest function is for testing ONLY.
  12 # It is NOT intended for actual use. If you do so, I will laugh at you.
  13 sub my_digest {
  14     my $key = shift;
  15     my $num = $salt;
  16
  17     for (my $k=0; $k<length($key); $k++) {
  18         $num += ord( substr($key, $k, 1) );
  19     }
  20
  21     return sprintf("%00000008d", $num);
  22 }
  23
  24 my $dbm_factory = new_dbm( digest => \&my_digest, hash_size => 8 );
  25 while ( my $dbm_maker = $dbm_factory->() ) {
  26     my $db = $dbm_maker->();
  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 done_testing;