Set::ConsistentHash - library for doing consistent hashing

  my $set = Set::ConsistentHash->new;

  Consistent hashing is a scheme that provides hash table
  functionality in a way that the addition or removal of one slot does
  not significantly change the mapping of keys to slots. In contrast,
  in most traditional hash tables, a change in the number of array
  slots causes nearly all keys to be remapped.

  Consistent hashing was introduced in 1997 as a way of distributing
  requests among a changing population of web servers. More recently,
  it and similar techniques have been employed in distributed hash
  tables.

  $set = Set::ConsistentHash->new;

    $set->set_targets(%target_to_weight);
    $set->set_targets("foo" => 5, "bar" => 10);

    $set->modify_targets(%target_to_weight);

    $set->set_target($target => $weight);

   $weight = $set->percent_weight($target);
   $weight = $set->percent_weight("10.0.0.2");

    $set->set_hash_func(\&your_hash_func);

    $selected_target = $set->get_target(your_hash_func($your_key));

    - or -

    $set->set_hash_func(\&your_hash_func);
    $selected_target = $set->get_target($your_key);

    $selected_target = $set->buckets->[your_hash_func($your_key) % 1024];

   $target = $set->target_of_point($point)

package Set::ConsistentHash;
use strict;
use Digest::SHA1 qw(sha1);
use Carp qw(croak);
use vars qw($VERSION);
$VERSION = '0.92';

# creates a new consistent hashing set with no targets.  you'll need to add targets.
sub new {
    my $class = shift;
    croak("Unknown parameters") if @_;
    my $self = bless {
        weights => {},  # $target => integer $weight
        points  => {},  # 32-bit value points on 'circle' => \$target
        order   => [],  # 32-bit points, sorted
        buckets      => undef, # when requested, arrayref of 1024 buckets mapping to targets
        total_weight => undef, # when requested, total weight of all targets
        hash_func    => undef, # hash function for key lookup
    }, $class;
    return $self;
}

############################################################################

############################################################################

sub targets {
    my $self = shift;
    return sort keys %{$self->{weights}};
}

############################################################################

sub reset_targets {
    my $self = shift;
    $self->modify_targets(map { $_ => 0 } $self->targets);
}
*clear = \&reset_targets;

############################################################################

sub set_targets {
    my $self = shift;
    $self->reset_targets;
    $self->modify_targets(@_);
}

############################################################################

# add/modify targets.  parameters are %weights:  $target -> $weight
sub modify_targets {
    my ($self, %weights) = @_;

    # uncache stuff:
    $self->{total_weight} = undef;
    $self->{buckets}      = undef;

    while (my ($target, $weight) = each %weights) {
        if ($weight) {
            $self->{weights}{$target} = $weight;
        } else {
            delete $self->{weights}{$target};
        }
    }
    $self->_redo_circle;
}

############################################################################

*set_target = \&modify_targets;

############################################################################

#'
sub total_weight {
    my $self = shift;
    return $self->{total_weight} if defined $self->{total_weight};
    my $sum = 0;
    foreach my $val (values %{$self->{weights}}) {
        $sum += $val;
    }
    return $self->{total_weight} = $sum;
}

############################################################################

sub percent_weight {
    my ($self, $target) = @_;
    return 0 unless $self->{weights}{$target};
    return 100 * $self->{weights}{$target} / $self->total_weight;
}

############################################################################

sub set_hash_func {
    my ($self, $hash_func) = @_;
    $self->{hash_func} = $hash_func;
}

############################################################################

sub get_target {
    my ($self, $key) = @_;
    _compute_buckets($self) unless $self->{buckets};
    $key = $self->{hash_func}->($key) if $self->{hash_func};
    return $self->{buckets}->[$key % 1024];
}

# returns arrayref of 1024 buckets.  each array element is the $target for that bucket index.
sub buckets {
    my $self = shift;
    _compute_buckets($self) unless $self->{buckets};
    return $self->{buckets};
}

############################################################################

# Computes and returns array of 1024 buckets.  Each array element is the
# $target for that bucket index.
sub _compute_buckets {
    my $self = shift;
    my @buckets = ();
    my $by = 2**22;  # 2**32 / 2**10 (1024)
    my $pt = 0;
    for my $n (0..1023) {
        $buckets[$n] = $self->target_of_point($pt);
        $pt += $by;
    }
    return $self->{buckets} = \@buckets;
}

# given a $point [0,2**32), returns the $target that's next going around the circle
sub target_of_point {
    my ($self, $pt) = @_;  # $pt is 32-bit unsigned integer

    my $order = $self->{order};
    my $circle_pt = $self->{points};

    my ($lo, $hi) = (0, scalar(@$order)-1);  # inclusive candidates

    while (1) {
        my $mid           = int(($lo + $hi) / 2);
        my $val_at_mid    = $order->[$mid];
        my $val_one_below = $mid ? $order->[$mid-1] : 0;

        # match
        return ${ $circle_pt->{$order->[$mid]} } if
            $pt <= $val_at_mid && $pt > $val_one_below;

        # wrap-around match
        return ${ $circle_pt->{$order->[0]} } if
            $lo == $hi;

        # too low, go up.
        if ($val_at_mid < $pt) {
            $lo = $mid + 1;
            $lo = $hi if $lo > $hi;
        }
        # too high
        else {
            $hi = $mid - 1;
            $hi = $lo if $hi < $lo;
        }

        next;
    }
};

############################################################################
#  Internal...
############################################################################

sub _redo_circle {
    my $self = shift;

    my $pts = $self->{points} = {};
    while (my ($target, $weight) = each %{$self->{weights}}) {
        my $num_pts = $weight * 100;
        foreach my $ptn (1..$num_pts) {
            my $key = "$target-$ptn";
            my $val = unpack("L", substr(sha1($key), 0, 4));
            $pts->{$val} = \$target;
        }
    }

    $self->{order} = [ sort { $a <=> $b } keys %$pts ];
}

1;