view release on metacpan or  search on metacpan

t/002_consistent_hash.t  view on Meta::CPAN

use strict;
use Test::More;
use Test::Requires
    'Digest::MD5'
;

use_ok "Algorithm::ConsistentHash::Ketama";

{
    my $ketama = Algorithm::ConsistentHash::Ketama->new();
    $ketama->add_bucket( "localhost:1001", 100 );
    $ketama->add_bucket( "localhost:1002", 200 );
    $ketama->add_bucket( "localhost:1003", 400 );

    note( "Running tests against original ketama object" );
    run_tests( $ketama );

    note( "Running tests against cloned ketama object" );
    my $clone = $ketama->clone;
    $clone->remove_bucket( "localhost:1000" );
    $clone->remove_bucket( "localhost:1004" );

    ok( $clone );
    run_tests( $clone );
    done_testing;
}

sub run_tests {
    my $ketama = shift;
{ # 1. simple check
    my $keys = add_keys(200);
    my $hashed = distribute($ketama, $keys);
    check_consistency($hashed);
    is $hashed->{"localhost:1000"}, -1;
    is $hashed->{"localhost:1004"}, -1;
}

{ # 2. add more buckets
    $ketama->add_bucket( "localhost:1000",   5 );
    $ketama->add_bucket( "localhost:1004", 800 );
    my $keys = add_keys(200);
    my $hashed = distribute($ketama, $keys);
    check_consistency($hashed);
}

{ # 3. remove buckets
    $ketama->remove_bucket( "localhost:1000" );
    my $keys = add_keys(200);
    my $hashed = distribute($ketama, $keys);
    check_consistency($hashed);
}

}
sub distribute {
    my ($ketama, $keys) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my %hashed;
    while ( my ($key, $expected) = each %$keys ) {
        my $got = $ketama->hash($key);
        if (ok $got, "got hashed value for $key as $got") {
            $hashed{$got}++;
        }
        # test logic for returning hash number
        my ($str, $num) = $ketama->hash_with_hashnum($key);
        is($str, $got, "->hash_with_hashnum returns same label as ->hash");
        $str = $ketama->label_from_hashnum($num);
        is($str, $got, "->label_from_hashnum returns same label as ->hash");
    }

    foreach my $key (qw( localhost:1000 localhost:1001 localhost:1002 localhost:1003 localhost:1004 )) {
        if (! defined $hashed{$key}) {
            $hashed{$key} = -1;
        }
    }