File Coverage

blib/lib/ShardedKV/Continuum/CHash.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package ShardedKV::Continuum::CHash;
2             {
3             $ShardedKV::Continuum::CHash::VERSION = '0.01';
4             }
5 1     1   44770 use Moose;
  0            
  0            
6             # ABSTRACT: Continuum implementation based on Algorithm::ConsistentHash::CHash
7             use Algorithm::ConsistentHash::CHash;
8             use JSON::XS qw(encode_json decode_json);
9              
10             with 'ShardedKV::Continuum';
11              
12             has '_orig_continuum_spec' => (
13             is => 'ro',
14             );
15              
16             has '_chash' => (
17             is => 'ro',
18             isa => 'Algorithm::ConsistentHash::CHash',
19             );
20              
21             sub choose {
22             $_[0]->_chash->lookup($_[1])
23             }
24              
25             # FIXME losing logger
26             sub serialize {
27             my $self = shift;
28             my $logger = $self->{logger};
29             $logger->debug("Serializing continuum, this will lose the logger!") if $logger;
30             encode_json( $self->_orig_continuum_spec )
31             }
32              
33             sub deserialize {
34             my $class = shift;
35             return $class->new(from => decode_json( $_[1] ));
36             }
37              
38             sub clone {
39             my $self = shift;
40             my $clone = ref($self)->new(from => $self->_orig_continuum_spec);
41             $clone->{logger} = $self->{logger};
42             return $clone;
43             }
44              
45             sub extend {
46             my $self = shift;
47             my $spec = shift;
48            
49             $self->_assert_spec_ok($spec);
50              
51             # Build clone of the original spec (to avoid action at a
52             # distance) and add the new nodes.
53             my $orig_spec = $self->_orig_continuum_spec;
54             my $clone_spec = {
55             %$orig_spec, # replicas + in case there's other gunk in it, at least make an effort
56             ids => [ @{$orig_spec->{ids}} ], # deep clone
57             };
58             push @{ $clone_spec->{ids} }, @{ $spec->{ids} };
59              
60             $self->{_chash} = $self->_make_chash($clone_spec);
61             $self->{_orig_continuum_spec} = $clone_spec;
62             return 1;
63             }
64              
65             sub get_bucket_names {
66             my $self = shift;
67              
68             return @{ $self->_orig_continuum_spec()->{ids} };
69             }
70              
71             sub BUILD {
72             my ($self, $args) = @_;
73              
74             my $from = delete $args->{from};
75             if (ref($from) eq 'HASH') {
76             $self->{_chash} = $self->_make_chash($from);
77             $self->{_orig_continuum_spec} = $from;
78             }
79             else {
80             die "Invalid 'from' specification for " . __PACKAGE__;
81             }
82             }
83              
84             sub _assert_spec_ok {
85             my ($self, $spec) = @_;
86             Carp::croak("Continuum spec must be a hash of the form {ids => [qw(node1 node2 node3)], replicas => 123}")
87             if not ref($spec) eq 'HASH'
88             or not ref($spec->{ids}) eq 'ARRAY'
89             or not @{$spec->{ids}};
90             return 1;
91             }
92              
93             sub _make_chash {
94             my ($self, $spec) = @_;
95              
96             $self->_assert_spec_ok($spec);
97              
98             return Algorithm::ConsistentHash::CHash->new(%$spec);
99             }
100              
101             no Moose;
102             __PACKAGE__->meta->make_immutable;
103              
104             __END__
105              
106             =pod
107              
108             =head1 NAME
109              
110             ShardedKV::Continuum::CHash - Continuum implementation based on Algorithm::ConsistentHash::CHash
111              
112             =head1 VERSION
113              
114             version 0.01
115              
116             =head1 SYNOPSIS
117              
118             use ShardedKV;
119             use ShardedKV::Continuum::CHash;
120             my $skv = ShardedKV->new(
121             continuum => ShardedKV::Continuum::CHash->new(
122             from => {
123             ids => [qw(node1 node2 node3 node4)],
124             replicas => 200,
125             }
126             ),
127             storages => {...},
128             );
129             ...
130             $skv->extend({ids => [qw(node5 node6 node7)]});
131              
132             =head1 DESCRIPTION
133              
134             A continuum implementation based on libchash consistent hashing.
135             See C<Algorithm::ConsistentHash::CHash>.
136              
137             =head1 SEE ALSO
138              
139             =over 4
140              
141             =item *
142              
143             L<ShardedKV>
144              
145             =item *
146              
147             L<ShardedKV::Continuum>
148              
149             =item *
150              
151             L<ShardedKV::Continuum::Ketama>
152              
153             =item *
154              
155             L<Algorithm::ConsistentHash::CHash>
156              
157             =item *
158              
159             L<Algorithm::ConsistentHash::Ketama>
160              
161             =back
162              
163             =head1 AUTHOR
164              
165             Steffen Mueller <smueller@cpan.org>
166              
167             =head1 COPYRIGHT AND LICENSE
168              
169             This software is copyright (c) 2013 by Steffen Mueller.
170              
171             This is free software; you can redistribute it and/or modify it under
172             the same terms as the Perl 5 programming language system itself.
173              
174             =cut