File Coverage

blib/lib/Cassandra/Client/Policy/LoadBalancing/Default.pm
Criterion Covered Total %
statement 14 67 20.9
branch 0 22 0.0
condition 0 11 0.0
subroutine 5 15 33.3
pod 0 10 0.0
total 19 125 15.2


line stmt bran cond sub pod time code
1             package Cassandra::Client::Policy::LoadBalancing::Default;
2             our $AUTHORITY = 'cpan:TVDW';
3             $Cassandra::Client::Policy::LoadBalancing::Default::VERSION = '0.21';
4 13     13   235 use 5.010;
  13         49  
5 13     13   76 use strict;
  13         26  
  13         390  
6 13     13   69 use warnings;
  13         28  
  13         629  
7 13     13   74 use List::Util 'shuffle';
  13         26  
  13         1175  
8 13     13   116 use Time::HiRes qw/time/;
  13         22  
  13         155  
9              
10             sub new {
11 0     0 0   my ($class, %args)= @_;
12 0           return bless {
13             datacenter => undef,
14             nodes => {},
15             local_nodes => {},
16             connected => {},
17             candidates => [],
18             try_times => {},
19             }, $class;
20             }
21              
22             sub get_distance {
23 0     0 0   my ($self, $peer)= @_;
24 0           my $node= $self->{nodes}{$peer};
25 0 0         if (!$node) {
26 0           warn 'Being asked about a distance for a node we don\'t know';
27 0           return 'ignored';
28             }
29              
30 0 0         if ($self->{local_nodes}{$peer}) {
31 0           return 'local';
32             }
33 0           return 'remote';
34             }
35              
36             sub on_new_node {
37 0     0 0   my ($self, $node)= @_;
38              
39 0           my $peer= $node->{peer};
40 0 0         if ($self->{nodes}{$peer}) {
41 0           warn 'BUG: "new" node is already known!';
42             }
43              
44 0           $self->{nodes}{$peer}= $node;
45 0 0 0       if (!$self->{datacenter} || $node->{data_center} eq $self->{datacenter}) {
46 0           $self->{local_nodes}{$peer}= $node;
47             }
48             }
49              
50             sub on_removed_node {
51 0     0 0   my ($self, $node)= @_;
52              
53 0           my $peer= $node->{peer};
54 0 0         if (!$self->{nodes}{$peer}) {
55 0           warn 'BUG: "removed" node wasn\'t there!';
56             }
57              
58 0           delete $self->{nodes}{$peer};
59 0           delete $self->{local_nodes}{$peer};
60             }
61              
62             sub get_next_candidate {
63 0     0 0   my ($self)= @_;
64 0           my $candidates= $self->{candidates};
65 0           while (my $maybe= shift @$candidates) {
66 0 0 0       if ($self->{local_nodes}{$maybe} && !$self->{connected}{$maybe} && $self->check_backoff($maybe)) {
      0        
67 0           return $maybe;
68             }
69             }
70 0 0         @$candidates= shuffle grep { !$self->{connected}{$_} && $self->check_backoff($_) } keys %{$self->{local_nodes}};
  0            
  0            
71 0           return shift @$candidates;
72             }
73              
74             my @all_backoff= map { $_ * (rand()*.4 + 0.8) } (1, 5, 20, 60, 180, 600);
75             sub check_backoff {
76 0     0 0   my ($self, $peer)= @_;
77 0           my $times= $self->{try_times}{$peer};
78 0 0         return 1 unless $times;
79              
80 0           my $count= 0+@$times;
81 0 0         $count= @all_backoff if $count > @all_backoff;
82 0           my $backoff= $all_backoff[$count-1];
83              
84 0 0         if (time() - $times->[-1] < $backoff) {
85 0           return;
86             }
87              
88 0           return 1;
89             }
90              
91             sub set_connecting {
92 0     0 0   my ($self, $peer)= @_;
93 0           $self->{connected}{$peer}= 1;
94 0   0       push @{$self->{try_times}{$peer} ||= []}, time;
  0            
95             }
96              
97             sub set_connected {
98 0     0 0   my ($self, $peer)= @_;
99 0 0         warn "BUG" unless $self->{connected}{$peer};
100 0           delete $self->{try_times}{$peer};
101             }
102              
103             sub set_disconnected {
104 0     0 0   my ($self, $peer)= @_;
105 0           delete $self->{connected}{$peer};
106             }
107              
108             sub known_node_count {
109 0     0 0   my ($self)= @_;
110 0           return (0+ keys %{$self->{local_nodes}});
  0            
111             }
112              
113             1;
114              
115             __END__