This file is indexed.

/usr/share/perl5/AnyEvent/Memcached/Buckets.pm is in libanyevent-memcached-perl 0.06-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
package #hide
	AnyEvent::Memcached::Buckets;

use common::sense 2;m{
use strict;
use warnings;
}x;
use Carp;

sub new {
	my $self = bless {}, shift;
	my %args = @_;
	$self->set_servers(delete $args{servers});
	$self;
}

sub set_servers {
	my $self = shift;
	my $list = shift or return;
	$list = [$list] unless ref $list eq 'ARRAY';
	$self->{servers} = $list || [];
	$self->_init_buckets;
	return $self;
}

sub peers {
	my $self = shift;
	@{$self->{servers}} or croak "servers not set during peers";
	$self->{peers};
}

sub _init_buckets {
	my $self = shift;
	@{$self->{servers}} or croak "servers not set during _init_buckets";
	if ($self->{buckets}) {
		@{ $self->{buckets} } = ();
	} else {
		$self->{buckets} = [];
	}
	my $bu = $self->{buckets};
	my $i = 0;
	foreach my $v (@{$self->{servers}}) {
		my $peer;
		my $buck = [ 0+@$bu ];
		if (ref $v eq "ARRAY") {
			$peer = $v->[0];
			for (1..$v->[1]) {
				push @$bu, $v->[0];
			}
			push @$buck, $buck->[0]+1 .. $#$bu;
		} else {
			push @$bu, $peer = $v;
		}
		my ($host,$port) = $peer =~ /^(.+?)(?:|:(\d+))$/;
		if ( exists $self->{peers}{$peer} ) {
			push @{ $self->{peers}{$peer}{bucks} }, @$buck;
		} else {
			push @{ $self->{srv} ||= [] }, $peer;
			$self->{peers}{$peer} = {
				index => $#{ $self->{srv} },
				bucks => $buck,
				host  => $host,
				port  => $port,
			};
		}
	}
	return;
}


sub peer {
	my $self = shift;
	my $hash = shift;
	@{$self->{servers}} or croak "servers not set during peer";
	return $self->{buckets}[ $hash % @{ $self->{buckets} } ];
}

sub next {
	my $self = shift;
	my $srv  = shift;
	@{$self->{servers}} or croak "servers not set during next";
	my $peer = $self->{peers}{$srv} or croak "No such server in buckets: $srv";
	my %args = @_;
	my $by = $args{by} || 1;
	my $next = ( $peer->{index} + $by ) % @{$self->{srv}};
	my $nsrv = $self->{srv}[$next] or die "Cant find next server by index $next";
	$nsrv = $nsrv->[0] if ref $nsrv;
	#warn R::Dump($nsrv);
	if ( ( my @bucks = @{ $self->{peers}{$nsrv}{bucks} } ) > 1 ) {
		my $which = $bucks[ ( $args{hash} || 0 ) % @bucks ];
		#warn "many buckets (@bucks) for $nsrv. using $which ($self->{buckets}[ $which ])";
		return $self->{buckets}[ $which ];
	} else {
		return $nsrv;
	}
}
sub prev {
	my $self = shift;
	my $srv  = shift;
	my %args = @_;
	my $by = $args{by} || 1;
	$self->next( $srv, %args, by => @{$self->{srv}}-$by );
}

1;