#! /usr/bin/perl
# -*- cperl -*-
#
# Copyright (C) 2009 Tomash Brechko.  All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself, either Perl version 5.8.8
# or, at your option, any later version of Perl 5 you may have
# available.
#
use v5.12;
use warnings;

=head1 NAME

ketama-distr.pl - compute relative distribution of keys.

=head1 SYNOPSIS

  ketama-distr.pl OPTIONS

=head1 OPTIONS

=over

=item C<--ketama_points, -k NUM>

B<Required, greater than zero.> Number of ketama points per server of
weight 1.

=item C<--server, -s HOST:PORT[:WEIGHT]>

B<Two or more.>  Specifies a server.  May be given multiple
times.  Default I<WEIGHT> is 1.

=back

=cut

use Getopt::Long qw(:config gnu_getopt);
use Pod::Usage;
use String::CRC32;

my %options;
if (   !GetOptions( \%options, qw(ketama_points|k=i server|s=s@) )
    || @ARGV
    || grep( { not defined } @options{qw(ketama_points server)} )
    || $options{ketama_points} <= 0
    || @{ $options{server} } < 2 )
{
    pod2usage(1);
}

sub compute_old {
    my ( $server, $index, $prev ) = @_;

    $server =~ s/:/\0/;

    my $point = crc32( $server . pack( "V", $index ) );

    return $point;
}

sub compute_new {
    my ( $server, $index, $prev ) = @_;

    $server =~ s/:/\0/;

    my $point = crc32( $server . pack( "V", $prev ) );

    return $point;
}

sub compute {
    my ($compute_point) = @_;

    my @continuum;

    my $j = 0;
    foreach my $s ( @{ $options{server} } ) {
        ++$j;
        my ( $server, $weight ) = $s =~ /^([^:]+:[^:]+)(?::(.+))?$/;

        die "$s should be HOST:PORT" unless defined $server;

        $weight = 1 unless defined $weight;

        my $prev = 0;
        for ( my $i = 0; $i < $options{ketama_points} * $weight; ++$i ) {
            my $point = $compute_point->( $server, $i, $prev );
            push @continuum, [ $point, "$j: $server" ];
            $prev = $point;
        }
    }

    use sort 'stable';
    @continuum = sort { $a->[0] <=> $b->[0] } @continuum;

    my $prev_point   = 0;
    my $first_server = '';
    my %server_share;
    foreach my $c (@continuum) {
        $first_server = $c->[1] unless $first_server;
        $server_share{ $c->[1] } += $c->[0] - $prev_point;
        $prev_point = $c->[0];
    }

    # Wraparound case.
    $server_share{$first_server} += 2**32 - 1 - $prev_point;

    foreach my $s ( sort keys %server_share ) {
        my $share = $server_share{$s};
        printf( "server %s  total = % 10u (%.2f%%)\n",
            $s, $share, $share * 100 / ( 2**32 - 1 ) );
    }

    return @continuum;
}

say 'Old:';
compute( \&compute_old );
say '';
say 'New:';
my $total_points = compute( \&compute_new );
say '';
my $int_size = 4;
say 'Continuum array size = ', $total_points * $int_size * 2, ' bytes';