File: Default.pm

package info (click to toggle)
libcassandra-client-perl 0.21-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 716 kB
  • sloc: perl: 3,898; ansic: 1,767; makefile: 3
file content (138 lines) | stat: -rw-r--r-- 3,032 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
package Cassandra::Client::Policy::LoadBalancing::Default;
our $AUTHORITY = 'cpan:TVDW';
$Cassandra::Client::Policy::LoadBalancing::Default::VERSION = '0.21';
use 5.010;
use strict;
use warnings;
use List::Util 'shuffle';
use Time::HiRes qw/time/;

sub new {
    my ($class, %args)= @_;
    return bless {
        datacenter => undef,
        nodes => {},
        local_nodes => {},
        connected => {},
        candidates => [],
        try_times => {},
    }, $class;
}

sub get_distance {
    my ($self, $peer)= @_;
    my $node= $self->{nodes}{$peer};
    if (!$node) {
        warn 'Being asked about a distance for a node we don\'t know';
        return 'ignored';
    }

    if ($self->{local_nodes}{$peer}) {
        return 'local';
    }
    return 'remote';
}

sub on_new_node {
    my ($self, $node)= @_;

    my $peer= $node->{peer};
    if ($self->{nodes}{$peer}) {
        warn 'BUG: "new" node is already known!';
    }

    $self->{nodes}{$peer}= $node;
    if (!$self->{datacenter} || $node->{data_center} eq $self->{datacenter}) {
        $self->{local_nodes}{$peer}= $node;
    }
}

sub on_removed_node {
    my ($self, $node)= @_;

    my $peer= $node->{peer};
    if (!$self->{nodes}{$peer}) {
        warn 'BUG: "removed" node wasn\'t there!';
    }

    delete $self->{nodes}{$peer};
    delete $self->{local_nodes}{$peer};
}

sub get_next_candidate {
    my ($self)= @_;
    my $candidates= $self->{candidates};
    while (my $maybe= shift @$candidates) {
        if ($self->{local_nodes}{$maybe} && !$self->{connected}{$maybe} && $self->check_backoff($maybe)) {
            return $maybe;
        }
    }
    @$candidates= shuffle grep { !$self->{connected}{$_} && $self->check_backoff($_) } keys %{$self->{local_nodes}};
    return shift @$candidates;
}

my @all_backoff= map { $_ * (rand()*.4 + 0.8) } (1, 5, 20, 60, 180, 600);
sub check_backoff {
    my ($self, $peer)= @_;
    my $times= $self->{try_times}{$peer};
    return 1 unless $times;

    my $count= 0+@$times;
    $count= @all_backoff if $count > @all_backoff;
    my $backoff= $all_backoff[$count-1];

    if (time() - $times->[-1] < $backoff) {
        return;
    }

    return 1;
}

sub set_connecting {
    my ($self, $peer)= @_;
    $self->{connected}{$peer}= 1;
    push @{$self->{try_times}{$peer} ||= []}, time;
}

sub set_connected {
    my ($self, $peer)= @_;
    warn "BUG" unless $self->{connected}{$peer};
    delete $self->{try_times}{$peer};
}

sub set_disconnected {
    my ($self, $peer)= @_;
    delete $self->{connected}{$peer};
}

sub known_node_count {
    my ($self)= @_;
    return (0+ keys %{$self->{local_nodes}});
}

1;

__END__

=pod

=head1 NAME

Cassandra::Client::Policy::LoadBalancing::Default

=head1 VERSION

version 0.21

=head1 AUTHOR

Tom van der Woerdt <tvdw@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2023 by Tom van der Woerdt.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut