Skip to content

Instantly share code, notes, and snippets.

@mala mala/gist:111540
Created May 14, 2009

Embed
What would you like to do?
package Cache::Balancer;
use strict;
use warnings;
use Carp;
use Scalar::Util;
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw(strict rules default debug));
our $VERSION = "0.01";
sub new {
my ($class, $opt) = @_;
$opt ||= {};
my $self = {
debug => 0,
strict => 0,
rules => [],
%{$opt}
};
return bless $self, $class;
}
BEGIN {
my @method = qw(get gets set add replace cas incr decr append prepend delete);
my @method_multi = map { $_ . "_multi" } @method;
for my $method_name ( @method ) {
eval sprintf( <<'__SUB__', $method_name, $method_name);
sub %s {
my $self = shift;
$self->_delegate("%s", @_);
}
__SUB__
}
for my $method_name (@method_multi) {
eval sprintf(<<'__SUB__', $method_name, $method_name);
sub %s {
my $self = shift;
$self->_delegate_multi("%s", @_);
}
__SUB__
}
}
sub add_rule {
my $self = shift;
my ($cond, $rule) = @_;
push @{$self->{rules}}, [$cond, $rule];
}
sub _test {
my ($self, $pattern, $key, $value) = @_;
my $type = ref $pattern;
return index($key, $pattern) == 0 unless $type;
return $key =~m{$pattern} if (ref $pattern eq "Regexp");
return $pattern->($key, $value) if (ref $pattern eq "CODE");
}
sub select_backend {
my ($self, $key, $value) = @_;
my @rules = @{$self->rules};
for my $pair (@rules) {
my ($pattern, $cache) = @{$pair};
next unless $self->_test($pattern, $key, $value);
return (ref $cache eq "CODE") ? $cache->($key, $value) : $cache;
}
# no match, use default cache
my $cache = $self->default;
return (ref $cache eq "CODE") ? $cache->($key, $value) : $cache;
}
sub _delegate {
my $self = shift;
my ($method, @args) = @_;
my $cache = $self->select_backend(@args);
if (!$cache) {
carp "can't find usable cache object" if $self->debug;
return
}
warn sprintf("select %s for %s:%s", ref $cache, $method, $args[0]) if $self->debug;
$cache->$method(@args);
}
sub _delegate_multi {
my $self = shift;
my ($method, @args) = @_;
if ($self->strict) {
my %backend;
my %request;
for my $pair (@args) {
my $cache = (ref $pair eq "ARRAY") ? $self->select_backend(@{$pair}) : $self->select_backend($pair);
if ($cache) {
my $id = Scalar::Util::refaddr($cache);
$backend{$id} ||= $cache;
$request{$id} ||= [];
push @{$request{$id}}, $pair;
}
}
my %result;
while ( my($id, $cache) = each %backend ) {
warn sprintf("select %s for %s", ref $cache, $method) if $self->debug;
my @req = @{$request{$id}};
my $got = $cache->$method(@req);
%result = (%result, %{$got});
}
return \%result;
} else {
my $first = $args[0];
my $cache = (ref $first eq "ARRAY") ? $self->select_backend(@{$first}) : $self->select_backend($first);
if (!$cache) {
carp "can't find usable cache object" if $self->debug;
return +{};
}
warn sprintf("select %s for %s", ref $cache, $method) if $self->debug;
return $cache->$method(@args);
}
}
1;
__END__
=pod
=head1 NAME
Cache::Balancer
=head1 SYNOPSIS
$cache = Cache::Balancer->new({
default => $cache,
# default => sub { return $cache }
});
$cache->add_rule($pattern, $cache);
# pattern can: String, Regexp, Coderef
# cache can: cache object or Coderef
# example:
$cache->add_rule('http', $http_cache); # cache for URI::Fetch, key start with "http"
$cache->add_rule(qr/Data::/, sub { my $key = shift; return $cache_for{$key} }); # complex rule for cache
$cache->add_rule(sub { my $key = shift; 1 }, sub { my $key = shift; return $cache_for{$key} }); # complex rule for key,cache
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.