@@ -1,9 +1,35 @@
Changes
=======
-0.02011 - 27 May 2011
- - Fix usage of foreach qw() which emits warnings under perl 5.14
- (rt #68487)
+0.04001 - 3rd Sept 2013
+ - Require Memcached::libmemcached 1.001701
+ - Fixed incr and decr methods to return undef on failure.
+
+0.03001 - 29 Oct 2010
+ - Require Memcached::libmemcached 0.4405
+ - Documented available libmemcached behaviours.
+ - All libmemcached behaviours can now be set via new({ behaviour_... => ... })!
+ - Optimized namespace support via libmemcached 'prefix key' mechanism.
+ - Fixed methods like incr() and decr() that didn't apply the namespace.
+ - Added namespace() method for Cache::Memcached::Fast compatibility.
+ - Added support for Cache::Memcached::Fast style hashref server specification.
+ - Added support for server weights.
+ - Added $keys parameter to stats()
+ - Removed malloc, sizes, and self from default stats() $keys.
+ - Added server_versions() method for Cache::Memcached::Fast compatibility.
+ - Added the documented enable_compress() method for Cache::Memcached compatibility.
+ - Removed undocumented version() method.
+ - Assorted documentation additions and cleanups.
+
+0.02011 - 27 May 2011 - ** NOTE DUPLICATE VERSION **
+ - Fix usage of foreach qw() which emits warnings under perl 5.14 (rt #68487)
+ ** This version has only these changes over 0.02010 **
+
+0.02011 - 26 Oct 2010
+ - Many more libmemcached behaviours are now accessible.
+ - stats() now returns many more items in the totals hash
+ - Fixed compression, thanks to Ask Bjørn Hansen, RT#46985
+ - Require Memcached::libmemcached 0.4402
0.02010 - 07 Sep 2009
- overhaul tests
@@ -128,4 +154,4 @@ Changes
0.00001 - 11 Jan 2008
- Initial release.
- - Only supportes get()/set()
\ No newline at end of file
+ - Only supportes get()/set()
@@ -1,5 +1,5 @@
---
-abstract: 'Perl Interface to libmemcached'
+abstract: 'Cache interface to Memcached::libmemcached'
author:
- 'Copyright (c) 2008 Daisuke Maki <daisuke@endeworks.jp>'
build_requires:
@@ -21,9 +21,9 @@ recommends:
Compress::Zlib: 0
requires:
Carp: 0
- Memcached::libmemcached: 0.4201
+ Memcached::libmemcached: 0.4405
Storable: 0
Task::Weaken: 0
resources:
license: http://dev.perl.org/licenses/
-version: 0.02010
+version: 0.03001
@@ -4,7 +4,7 @@ use inc::Module::Install;
name('Cache-Memcached-libmemcached');
all_from('lib/Cache/Memcached/libmemcached.pm');
-requires('Memcached::libmemcached', '0.4201');
+requires('Memcached::libmemcached', '1.001701');
requires('Storable');
requires('Carp');
requires('Task::Weaken');
@@ -1,19 +1,28 @@
-
package Cache::Memcached::libmemcached;
+
+require bytes;
use strict;
use warnings;
+
+use Memcached::libmemcached 1.001701, qw(
+ MEMCACHED_CALLBACK_PREFIX_KEY
+ MEMCACHED_PREFIX_KEY_MAX_SIZE
+);
use base qw(Memcached::libmemcached);
-use Carp qw(croak);
+
+use Carp qw(croak carp);
use Scalar::Util qw(weaken);
use Storable ();
-our $VERSION = '0.02011';
+our $VERSION = '0.04001';
use constant HAVE_ZLIB => eval { require Compress::Zlib } && !$@;
use constant F_STORABLE => 1;
use constant F_COMPRESS => 2;
use constant OPTIMIZE => $ENV{PERL_LIBMEMCACHED_OPTIMIZE} ? 1 : 0;
+my %behavior;
+
BEGIN
{
# Make sure to load bytes.pm if HAVE_ZLIB is enabled
@@ -29,19 +38,17 @@ BEGIN
EOSUB
die if $@;
}
+ # for Cache::Memcached compatibility
+ sub enable_compress { shift->set_compress_enable(@_) }
+ # XXX this should be done via subclasses
if (OPTIMIZE) {
# If the optimize flag is enabled, we do not support master key
# generation, cause we really care about the speed.
foreach my $method (qw(get set add replace prepend append cas delete)) {
eval <<" EOSUB";
sub $method {
- my \$self = shift;
- my \$key = shift;
- if (\$self->{namespace}) {
- \$key = "\$self->{namespace}\$key";
- }
- \$self->SUPER::memcached_${method}(\$key, \@_)
+ shift->SUPER::memcached_${method}(\@_)
}
EOSUB
die if $@;
@@ -56,14 +63,9 @@ BEGIN
sub $method {
my \$self = shift;
my \$key = shift;
- my \$master_key;
- if (ref \$key eq 'ARRAY') {
- (\$master_key, \$key) = @\$key;
- }
-
- if (\$self->{namespace}) {
- \$key = "\$self->{namespace}\$key";
- }
+ return \$self->SUPER::memcached_${method}(\$key, \@_)
+ unless ref \$key;
+ (my \$master_key, \$key) = @\$key;
if (\$master_key) {
\$self->SUPER::memcached_${method}_by_key(\$master_key, \$key, \@_);
} else {
@@ -74,6 +76,36 @@ BEGIN
die if $@;
}
}
+
+ # Create get_*/is_*/set_* methods for some libmemcached behaviors.
+ # We only do this for some because there are many and it's easy for
+ # the user to use memcached_behavior_set() etc directly.
+ #
+ %behavior = (
+ # non-boolean behaviors that are renamed (to be more descriptive)
+ distribution_method => [ 0, 'distribution' ],
+ hashing_algorithm => [ 0, 'hash' ],
+ # boolean behaviors that are not renamed:
+ no_block => [ 1 ],
+ binary_protocol => [ 1 ],
+ );
+
+ while ( my ($method, $field_info) = each %behavior ) {
+ my $is_bool = $field_info->[0];
+ my $field = $field_info->[1] || $method;
+
+ my $behavior = "Memcached::libmemcached::MEMCACHED_BEHAVIOR_\U$field";
+ warn "$behavior doesn't exist\n" # sanity check
+ unless do { no strict 'refs'; defined &$behavior };
+
+ my ($set, $get) = ("set_$method", "get_$method");
+ $get = "is_$method" if $is_bool;
+ my $code = "sub $set { \$_[0]->memcached_behavior_set($behavior(), \$_[1]) }\n"
+ . "sub $get { \$_[0]->memcached_behavior_get($behavior()) }";
+ eval $code;
+ die "$@ while executing $code" if $@;
+ }
+
}
sub import
@@ -85,19 +117,48 @@ sub import
sub new
{
my $class = shift;
- my $args = shift || {};
-
- $args->{servers} || die "No servers specified";
+ my %args = %{ shift || {} };
my $self = $class->SUPER::new();
- $self->{compress_threshold} = $args->{compress_threshold};
- $self->{compress_savingsS} = $args->{compress_savings} || 0.20;
+ $self->trace_level(delete $args{debug}) if exists $args{debug};
+
+ $self->namespace(delete $args{namespace})
+ if exists $args{namespace};
+
+ $self->{compress_threshold} = delete $args{compress_threshold};
+ # Add support for Cache::Memcache::Fast's compress_ratio
+ $self->{compress_savingsS} = delete $args{compress_savings} || 0.20;
$self->{compress_enable} =
- exists $args->{compress_enable} ? $args->{compress_enable} : 1;
+ exists $args{compress_enable} ? delete $args{compress_enable} : 1;
# servers
- $self->set_servers($args->{servers});
+ $args{servers} || croak "No servers specified";
+ $self->set_servers(delete $args{servers});
+
+ # old-style behavior options (see behavior_ block below)
+ foreach my $option (qw(no_block hashing_algorithm distribution_method binary_protocol)) {
+ my $behavior = $behavior{$option}->[1] || $option;
+ $args{"behavior_$behavior"} = delete $args{$option} if exists $args{$option};
+ }
+
+ # allow any libmemcached behavior to be set via args to new()
+ for my $name (grep { /^behavior_/ } keys %args) {
+ my $value = delete $args{$name};
+ my $behavior = "Memcached::libmemcached::MEMCACHED_\U$name";
+ no strict 'refs';
+ if (not defined &$behavior) {
+ carp "$name ($behavior) isn't available"; # sanity check
+ next;
+ }
+ $self->memcached_behavior_set(&$behavior(), $value);
+ }
+
+ delete $args{readonly};
+ delete $args{no_rehash};
+
+ carp "Unrecognised options: @{[ sort keys %args ]}"
+ if %args;
# Set compression/serialization callbacks
$self->set_callback_coderefs(
@@ -108,18 +169,33 @@ sub new
# behavior options
foreach my $option (qw(no_block hashing_algorithm distribution_method binary_protocol)) {
my $method = "set_$option";
- $self->$method( $args->{$option} ) if exists $args->{$option};
+ $self->$method( $args{$option} ) if exists $args{$option};
}
- $self->{namespace} = $args->{namespace} || '';
-
return $self;
}
+sub namespace {
+ my $self = shift;
+
+ my $old_namespace = $self->memcached_callback_get(MEMCACHED_CALLBACK_PREFIX_KEY);
+ if (@_) {
+ my $namespace = shift;
+ $self->memcached_callback_set(MEMCACHED_CALLBACK_PREFIX_KEY, $namespace)
+ or carp $self->errstr;
+ }
+
+ return $old_namespace;
+}
+
sub set_servers
{
my $self = shift;
my $servers = shift || [];
+
+ # $self->{servers} = []; # for compatibility with Cache::Memcached
+
+ # XXX should delete any existing servers from libmemcached
foreach my $server (@$servers) {
$self->server_add($server);
}
@@ -128,19 +204,34 @@ sub set_servers
sub server_add
{
my $self = shift;
- my $server = shift;
-
- if (! defined $server) {
- Carp::confess("server is not defined");
+ my $server = shift
+ or Carp::confess("server not specified");
+
+ my $weight = 0;
+ if (ref $server eq 'ARRAY') {
+ my @ary = @$server;
+ $server = shift @ary;
+ $weight = shift @ary || 0 if @ary;
+ }
+ elsif (ref $server eq 'HASH') { # Cache::Memcached::Fast
+ my $h = $server;
+ $server = $h->{address};
+ $weight = $h->{weight} if exists $h->{weight};
+ # noreply is not supported
}
+
if ($server =~ /^([^:]+):([^:]+)$/) {
my ($hostname, $port) = ($1, $2);
- $self->memcached_server_add($hostname, $port );
+ $self->memcached_server_add_with_weight($hostname, $port, $weight);
} else {
- $self->memcached_server_add_unix_socket( $server );
+ $self->memcached_server_add_unix_socket_with_weight( $server, $weight );
}
+
+ # for compatibility with Cache::Memcached
+ # push @{$self->{servers}}, $server;
}
+
sub _mk_callbacks
{
my $self = shift;
@@ -174,7 +265,7 @@ sub _mk_callbacks
my $length = bytes::length($_);
if ($length > $self->{compress_threshold}) {
my $tmp = Compress::Zlib::memGzip($_);
- if (1 - bytes::length($tmp) / $length < $self->{compress_savingsS}) {
+ if (bytes::length($tmp) / $length < 1 - $self->{compress_savingsS}) {
$_ = $tmp;
$_[1] |= F_COMPRESS;
}
@@ -190,11 +281,8 @@ sub incr
my $self = shift;
my $key = shift;
my $offset = shift || 1;
- if ($self->{namespace}) {
- $key = "$self->{namespace}$key";
- }
my $val = 0;
- $self->memcached_increment($key, $offset, $val);
+ $self->memcached_increment($key, $offset, $val) || return undef;
return $val;
}
@@ -203,22 +291,11 @@ sub decr
my $self = shift;
my $key = shift;
my $offset = shift || 1;
- if ($self->{namespace}) {
- $key = "$self->{namespace}$key";
- }
my $val = 0;
- $self->memcached_decrement($key, $offset, $val);
+ $self->memcached_decrement($key, $offset, $val) || return undef;
return $val;
}
-sub get_multi {
- my $self = shift;
-
- my $namespace = $self->{namespace};
- my @keys = $namespace ? map { "$namespace$_" } @_ : @_;
- my $hash = $self->SUPER::get_multi(@keys);
- return $namespace ? +{ map { ($_ => $hash->{"$namespace$_"}) } @_ } : $hash;
-}
sub flush_all
{
@@ -231,93 +308,96 @@ sub disconnect_all {
$_[0]->memcached_quit();
}
-sub version {
- $_[0]->memcached_version();
+
+sub server_versions {
+ my $self = shift;
+ my %versions;
+ # XXX not optimal, libmemcached knows these values without having to send a stats request
+ $self->walk_stats('', sub {
+ my ($key, $value, $hostport) = @_;
+ $versions{$hostport} = $value if $key eq 'version';
+ return;
+ });
+ return \%versions;
}
+
sub stats
{
- my %h;
- my %misc_keys = map { ($_ => 1) }
- qw/ bytes bytes_read bytes_written
- cmd_get cmd_set connection_structures curr_items
- get_hits get_misses
- total_connections total_items
- /;
- my $code = sub {
- my($key, $value, $hostport, $type) = @_;
-
- # XXX - This is hardcoded in the callback cause r139 in perl-memcached
- # removed the magic of "misc"
- $type ||= 'misc';
- $h{hosts}{$hostport}{$type}{$key} = $value;
- if ($type eq 'misc') {
- if ($misc_keys{$key}) {
- $h{total}{$key} ||= 0;
- $h{total}{$key} += $value;
- }
- } elsif ($type eq 'malloc') {
- $h{total}{"malloc_$key"} ||= 0;
- $h{total}{"malloc_$key"} += $value;
- }
- return ();
- };
- $_[0]->walk_stats($_, $code) for ('', qw(malloc sizes self));
- return \%h;
-}
+ my $self = shift;
+ my ($stats_args) = @_;
-BEGIN
-{
- my @boolean_behavior = qw( no_block binary_protocol );
- my %behavior = (
- distribution_method => 'distribution',
- hashing_algorithm => 'hash'
- );
+ # http://github.com/memcached/memcached/blob/master/doc/protocol.txt
+ $stats_args = [ $stats_args ]
+ if $stats_args and not ref $stats_args;
+ $stats_args ||= [ '' ];
- foreach my $name (@boolean_behavior) {
- my $code = sprintf(<<' EOSUB', $name, uc $name, $name, uc $name);
- sub is_%s {
- $_[0]->memcached_behavior_get( Memcached::libmemcached::MEMCACHED_BEHAVIOR_%s() );
- }
+ # stats keys that aren't matched by the prefix and suffix regexes below
+ # but which we want to accumulate in totals
+ my %total_misc_keys = map { ($_ => 1) } qw(
+ bytes evictions
+ connection_structures curr_connections total_connections
+ );
- sub set_%s {
- $_[0]->memcached_behavior_set( Memcached::libmemcached::MEMCACHED_BEHAVIOR_%s(), $_[1] );
+ my %h;
+ for my $type (@$stats_args) {
+
+ my $code = sub {
+ my ($key, $value, $hostport) = @_;
+
+ # XXX - This is hardcoded in the callback cause r139 in perl-memcached
+ # removed the magic of "misc"
+ $type ||= 'misc';
+ $h{hosts}{$hostport}{$type}{$key} = $value;
+ #warn "$_ ($key, $value, $hostport, $type)\n";
+
+ # accumulate overall totals for some items
+ if ($type eq 'misc') {
+ if ($total_misc_keys{$key}
+ or $key =~ /^(?:cmd|bytes)_/ # prefixes
+ or $key =~ /_(?:hits|misses|errors|yields|badval|items|read|written)$/ # suffixes
+ ) {
+ $h{total}{$key} += $value;
+ }
}
- EOSUB
- eval $code;
- die if $@;
- }
-
- while (my($method, $field) = each %behavior) {
- my $code = sprintf(<<' EOSUB', $method, uc $field, $method, uc $field);
- sub get_%s {
- $_[0]->memcached_behavior_get( Memcached::libmemcached::MEMCACHED_BEHAVIOR_%s() );
+ elsif ($type eq 'malloc' or $type eq 'sizes') {
+ $h{total}{"${type}_$key"} += $value;
}
+ return;
+ };
- sub set_%s {
- $_[0]->memcached_behavior_set( Memcached::libmemcached::MEMCACHED_BEHAVIOR_%s(), $_[1]);
- }
- EOSUB
- eval $code;
- die if $@;
+ $self->walk_stats($type, $code);
}
+ return \%h;
}
+# for compatability with Cache::Memcached and Cache::Memcached::Managed 0.20:
+# https://rt.cpan.org/Ticket/Display.html?id=62512
+# sub sock_to_host { undef }
+# sub get_sock { undef }
+# sub forget_dead_hosts { undef }
+
1;
__END__
=head1 NAME
-Cache::Memcached::libmemcached - Perl Interface to libmemcached
+Cache::Memcached::libmemcached - Cache interface to Memcached::libmemcached
=head1 SYNOPSIS
use Cache::Memcached::libmemcached;
+
my $memd = Cache::Memcached::libmemcached->new({
- servers => [ "10.0.0.15:11211", "10.0.0.15:11212", "/var/sock/memcached" ],
- compress_threshold => 10_000
+ servers => [
+ "10.0.0.15:11211",
+ [ "10.0.0.15:11212", 2 ], # weight
+ "/var/sock/memcached"
+ ],
+ compress_threshold => 10_000,
+ # ... many more options supported
});
$memd->set("my_key", "Some value");
@@ -325,7 +405,7 @@ Cache::Memcached::libmemcached - Perl Interface to libmemcached
$val = $memd->get("my_key");
$val = $memd->get("object_key");
- if ($val) { print $val->{complex}->[2] }
+ print $val->{complex}->[2] if $val;
$memd->incr("key");
$memd->decr("key");
@@ -336,27 +416,25 @@ Cache::Memcached::libmemcached - Perl Interface to libmemcached
my $hashref = $memd->get_multi(@keys);
- # Constants - explicitly by name or by tags
- # see Memcached::libmemcached::constants for a list
+ # Import Memcached::libmemcached constants - explicitly by name or by tags
+ # see Memcached::libmemcached::constants for a list
use Cache::Memcached::libmemcached qw(MEMCACHED_DISTRIBUTION_CONSISTENT);
use Cache::Memcached::libmemcached qw(
- :defines
- :memcached_allocated
- :memcached_behavior
- :memcached_callback
- :memcached_connection
- :memcached_hash
- :memcached_return
- :memcached_server_distribution
+ :defines
+ :memcached_allocated
+ :memcached_behavior
+ :memcached_callback
+ :memcached_connection
+ :memcached_hash
+ :memcached_return
+ :memcached_server_distribution
);
- # Extra constructor options that are not in Cache::Memcached
- # See Memcached::libmemcached::constants for a list of available options
my $memd = Cache::Memcached::libmemcached->new({
- ...,
- no_block => $boolean,
- distribution_method => $distribution_method,
- hashing_algorithm => $hashing_algorithm,
+ distribution_method => MEMCACHED_DISTRIBUTION_CONSISTENT,
+ hashing_algorithm => MEMCACHED_HASH_FNV1A_32,
+ behavior_... => ...,
+ ...
});
=head1 DESCRIPTION
@@ -369,55 +447,90 @@ While Memcached::libmemcached aims to port libmemcached API to perl,
Cache::Memcached::libmemcached attempts to be API compatible with
Cache::Memcached, so it can be used as a drop-in replacement.
-Note that as of version 0.02000, Cache::Memcached::libmemcached I<inherits>
-from Memcached::libmemcached. While you are free to use the
-Memcached::libmemcached specific methods directly on the object, you should
-use them with care, as it will mean that your code is no longer compatible
-with the Cache::Memcached API therefore losing some of th portability in
+Cache::Memcached::libmemcached I<inherits> from Memcached::libmemcached.
+While you are free to use the Memcached::libmemcached specific methods directly
+on the object, doing so will mean that your code is no longer compatible with
+the original Cache::Memcached API therefore losing some of the portability in
case you want to replace it with some other package.
-=head1 FOR Cache::Memcached::LibMemcached USERS
+=head1 Cache::Memcached COMPATIBLE METHODS
+
+Except for the minor incompatiblities, below methods are compatible with
+Cache::Memcached.
-Cache::Memcached::libmemcached is a rewrite of Cache::Memcached::LibMemcached,
-using Memcached::libmemcached instead of straight XS as its backend.
+=head2 new
-Therefore you might notice some differences. Here are the ones we are
-aware of:
+Takes one parameter, a hashref of options.
-=over 4
+=head3 Cache::Memcached options:
-=item cas() is not implemented
+=head3 servers
-This was sort of implemented in a previous life, but since
-Memcached::libmemcached is still undecided how to handle it, we don't
-support it either.
+The value is passed to the L</set_servers> method.
-=item performance is probably a bit different
+=head3 compress_threshold
-To be honest, we haven't ran benchmarks comparing the two (yet). In general,
-you might see a decrease in performance here and there because we've
-essentially added another call stack (instead of going straight from perl to
-XS, we are now going from perl to perl to XS). But on the other hand,
-Memcached::libmemcached is in the hands of XS gurus like Time Bunce, so
-you are probably sparing yourself some accidental hooplas that occasional
-C programmers like me might introduce.
+Set a compression threshold, in bytes. Values larger than this threshold will
+be compressed by set and decompressed by get.
-=back
+=head3 namespace
-=head1 Cache::Memcached COMPATIBLE METHODS
+The value is passed to the L</namespace> method.
-Except for the minor incompatiblities, below methods are generally compatible
-with Cache::Memcached.
+=head3 debug
-=head2 new
+Sets the C<trace_level> for the Memcached::libmemcached object.
+
+=head3 readonly, no_rehash
+
+These Cache::Memcached options are not supported.
+
+=head3 Options specific to Cache::Memcached::libmemcached:
+
+=head3 compress_savings
+
+=head3 behavior_*
+
+Any of the I<many> behaviors documented in
+L<Memcached::libmemcached::memcached_behavior> can be specified by using
+argument key names that start with C<behavior_>. For example:
+
+ behavior_ketama_weighted => 1,
+ behavior_noreply => 1,
+ behavior_number_of_replicas => 2,
+ behavior_server_failure_limit => 3,
+ behavior_auto_eject_hosts => 1,
+
+=head3 no_block
-Takes on parameter, a hashref of options.
+=head3 hashing_algorithm
+
+=head3 distribution_method
+
+=head3 binary_protocol
+
+These are equivalent to the same options prefixed with C<behavior_>.
=head2 set_servers
- $memd->set_servers( [ qw(serv1:port1 serv2:port2 ...) ]);
+ $memd->set_servers( [ 'serv1:port1', 'serv2:port2', ... ]);
+
+Calls L</server_add> for each element of the supplied arrayref.
+See L</server_add> for details of valid values, including how to specify weights.
+
+=head2 namespace
+
+ $memd->namespace;
+ $memd->namespace($string);
+
+Without the argument return the current namespace prefix. With the
+argument set the namespace prefix to I<$string>, and return the old prefix.
+
+The effect is to pefix all keys with the provided namespace value. That is, if
+you set namespace to "app1:" and later do a set of "foo" to "bar", memcached is
+actually seeing you set "app1:foo" to "bar".
-Sets the server list.
+The namespace string must be less than 128 bytes (MEMCACHED_PREFIX_KEY_MAX_SIZE).
=head2 get
@@ -476,6 +589,7 @@ memcached > 1.2.4
my $newval = $memd->incr($key);
my $newval = $memd->decr($key);
+
my $newval = $memd->incr($key, $offset);
my $newval = $memd->decr($key, $offset);
@@ -487,11 +601,15 @@ by $key. Returns undef if the key doesn't exist on the server.
=head2 remove
$memd->delete($key);
+ $memd->delete($key, $time);
Deletes a key.
-XXX - The behavior when second argument is specified may differ from
-Cache::Memcached -- this hasn't been very well tested. Patches welcome!
+If $time is non-zero then the item is marked for later expiration. Expiration
+works by placing the item into a delete queue, which means that it won't
+possible to retrieve it by the "get" command, but "add" and "replace" command
+with this key will also fail (the "set" command will succeed, however). After
+the time passes, the item is finally deleted from server memory.
=head2 flush_all
@@ -516,9 +634,36 @@ from Cache::Memcached is, despite its naming, a setter as well.
=head2 stats
my $h = $memd->stats();
+ my $h = $memd->stats($keys);
+
+Returns a hashref of statistical data regarding the memcache server(s), the
+$memd object, or both. $keys can be an arrayref of keys wanted, a single key
+wanted, or absent (in which case the default value is C<[ '' ]>). For each
+key the C<stats> command is run on each server.
+
+For example C<<$memd->stats([ '', 'sizes' ])>> would return a structure like
+this:
+
+ {
+ hosts => {
+ 'N.N.N.N:P' => {
+ misc => {
+ ...
+ },
+ sizes => {
+ ...
+ },
+ },
+ ...,
+ },
+ totals => {
+ ...
+ }
+ }
-This method is still half-baked. It gives you some stats. If the values are
-wrong, well, reports, or better yet, patches welcome.
+The general stats (where the key is "") are returned with a key of C<misc>.
+The C<totals> element contains the aggregate totals for all hosts of some of
+the statistics.
=head2 disconnect_all
@@ -528,24 +673,24 @@ Disconnects from servers
$memd->cas($key, $cas, $value[, $exptime]);
-XXX - This method is still broken.
-
-Sets if $cas matches the value on the server.
+Overwrites data in the server as long as the "cas" value is still the same in
+the server.
-=head2 gets
+You can get the cas value of a result by calling memcached_result_cas() on a
+memcached_result_st(3) structure.
-=head2 get_cas
+Support for "cas" is disabled by default as there is a slight performance
+penalty. To enable it use the C<support_cas> option to L</new>.
- my $cas = $memd->gets($key);
- my $cas = $memd->get_cas($key);
-Get the CAS value for $key
+=head1 Cache::Memcached::Fast COMPATIBLE METHODS
-=head2 get_cas_multi
+=head2 server_versions
- my $h = $memd->get_cas_multi(@keys)
+ $href = $memd->server_versions;
-Gets CAS values for multiple keys
+Returns a reference to hash, where $href->{$server} holds corresponding server
+version string, e.g. "1.4.4". $server is either host:port or /path/to/unix.sock.
=head1 Cache::Memcached::libmemcached SPECIFIC METHODS
@@ -553,15 +698,12 @@ These methods are libmemcached-specific.
=head2 server_add
-Adds a memcached server.
-
-=head2 server_add_unix_socket
-
-Adds a memcached server, connecting via unix socket.
-
-=head2 server_list_free
+ $self->server_add( $server_host_port ); # 10.10.10.10:11211
+ $self->server_add( $server_socket_path ); # /path/to/socket
+ $self->server_add( [ $server, $weight ] );
+ $self->server_add( { address => $server, weight => $weight } );
-Frees the memcached server list.
+Adds a memcached server address with an optional weight (default 0).
=head1 UTILITY METHODS
@@ -590,31 +732,21 @@ Return the current value of compress_savings
=head1 BEHAVIOR CUSTOMIZATION
-Certain libmemcached behaviors can be configured with the following
-methods.
+Memcached::libmemcached supports I<many> 'behaviors' that can be used to
+configure the behavior of the library and its interaction with the servers.
-(NOTE: This API is not fixed yet)
-
-=head2 behavior_set
+Certain libmemcached behaviors can be configured with the following methods.
-=head2 behavior_get
-
-If you want to customize something that we don't have a wrapper for,
-you can directly use these method.
+(NOTE: This API is not fixed yet)
=head2 set_no_block
- Cache::Memcached::libmemcached->new({
- ...
- no_block => 1
- });
- # or
$memd->set_no_block( 1 );
Set to use blocking/non-blocking I/O. When this is in effect, get() becomes
flaky, so don't attempt to call it. This has the most effect for set()
operations, because libmemcached stops waiting for server response after
-writing to the socket (set() will also always return success)
+writing to the socket (set() will also always return success).
Please consult the man page for C<memcached_behavior_set()> for details
before setting.
@@ -643,35 +775,25 @@ Set the hashing algorithm used.
Get the hashing algorithm used.
-=head2 set_support_cas
-
- $memd->set_support_cas($boolean);
- # or
- $memd = Cache::Memcached::libmemcached->new( {
- ...
- support_cas => 1
- } );
+=head2 set_binary_protocol
-Enable/disable CAS support.
-
-=head1 set_binary_protocol
+=head2 is_binary_protocol
$memd->set_binary_protocol( 1 );
$binary = $memd->is_binary_protocol();
-Enable/disable binary protocol
+Use C<set_binary_protocol> to enable/disable binary protocol.
+Use C<is_binary_protocol> to determine the current setting.
=head1 OPTIMIZE FLAG
-There's an EXPERIMENTAL optimization available for some corner cases, where
-if you know before hand that you won't be using some features, you can
-disable them all together for some performance boost. To enable this mode,
-set an environment variable named PERL_LIBMEMCACHED_OPTIMIZE to a true value
-
-=head2 NO MASTER KEY SUPPORT
+If you are 100% sure that you won't be using the master key support (where
+you provide an arrayref as the key) you can get about 4~5% performance boost
+by setting the environment variable named PERL_LIBMEMCACHED_OPTIMIZE to a true
+value I<before> loading the module.
-If you are 100% sure that you won't be using the master key support, where
-you provide an arrayref as the key, you get about 4~5% performance boost.
+This is an EXPERIMENTAL optimization and will possibly be replaced by
+implementing the methods in C in Memcached::libmemcached.
=head1 VARIOUS MEMCACHED MODULES
@@ -683,43 +805,69 @@ main dev environment)
=head2 Cache::Memcached
-This is the "main" module. It's mostly written in Perl.
+This is the "original" module. It's mostly written in Perl, is slow, and lacks
+significant features like support for the binary protocol.
=head2 Cache::Memcached::libmemcached
-Cache::Memcached::libmemcached, which is the module for which your reading
-the document of, is a perl binding for libmemcached (http://tangent.org/552/libmemcached.html). Not to be confused with libmemcache (see below).
+Cache::Memcached::libmemcached, this module,
+is a perl binding for libmemcached (http://tangent.org/552/libmemcached.html).
+Not to be confused with libmemcache (see below).
=head2 Cache::Memcached::Fast
Cache::Memcached::Fast is a memcached client written in XS from scratch.
As of this writing benchmarks shows that Cache::Memcached::Fast is faster on
-get_multi(), and Cache::Memcached::libmemcached is faster on regular get()/set()
+get_multi(), and Cache::Memcached::libmemcached is faster on regular get()/set().
+Cache::Memcached::Fast doesn't support the binary protocol.
=head2 Memcached::libmemcached
-Memcached::libmemcached is a straight binding to libmemcached, and is also
-the parent class of this module.
+Memcached::libmemcached is a thin binding to the libmemcached C library
+and provides access to most of the libmemcached API.
-It has most of the libmemcached API. If you don't care about a drop-in
-replacement for Cache::Memcached, and want to benefit from low level API that
-libmemcached offers, this is the way to go.
+If you don't care about a drop-in replacement for Cache::Memcached, and want to
+benefit from the feature-rich efficient API that libmemcached offers, this is
+the way to go.
+
+Since the Memcached::libmemcached module is also the parent class of this module
+you can call Memcached::libmemcached methods directly.
=head2 Cache::Memcached::XS
Cache::Memcached::XS is a binding for libmemcache (http://people.freebsd.org/~seanc/libmemcache/).
The main memcached site at http://danga.com/memcached/apis.bml seems to
indicate that the underlying libmemcache is no longer in active development.
+The module hasn't been updated since 2006.
+
+=head1 TODO
+
+Check and improve compatibility with Cache::Memcached::Fast.
+
+Add forget_dead_hosts() for greater Cache::Memcached compatibility?
-=head1 CAVEATS
+Treat PERL_LIBMEMCACHED_OPTIMIZE as the default and add a subclass that
+handles the arrayref master key concept. Then
+the custom methods (get set add replace prepend append cas
+delete) can then all be removed and the libmemcached ones used directly.
+Alternatively, add master key via array ref support to the methods in
+::libmemcached. Either way the effect on performance should be significant.
-Unless you know what you're getting yourself into, don't try to subclass this
-module just yet. Internal structures may change without notice.
+Redo tools/benchmarks.pl performance tests (ensuring that methods are not called in
+void context unless it's appropriate).
+
+Try using Cache::Memcached::Fast's test suite to test this module.
+Via private lib/Cache/Memcached/libmemcachedAsFast.pm wrapper.
+
+Implement automatic no-reply on calls in void context (like Cache::Memcached::Fast).
+That should yield a signigicant performance boost.
=head1 AUTHOR
Copyright (c) 2008 Daisuke Maki E<lt>daisuke@endeworks.jpE<gt>
+With contributions by Tim Bunce.
+
=head1 LICENSE
This program is free software; you can redistribute it and/or modify it
@@ -727,4 +875,4 @@ under the same terms as Perl itself.
See http://www.perl.com/perl/misc/Artistic.html
-=cut
\ No newline at end of file
+=cut
@@ -23,9 +23,7 @@ isa_ok($cache, "Cache::Memcached::libmemcached");
is_deeply( $h, \%expected, "got all the expected values");
}
-TODO: {
- local $TODO = "Memcached::libmemcached flag support required";
-
+{
my $key = 'complex-get_multi';
my %data = (foo => [ qw(1 2 3) ]);
@@ -34,7 +32,6 @@ TODO: {
my $h = $cache->get_multi($key);
is_deeply($h->{$key}, \%data);
-
}
{
@@ -3,31 +3,9 @@ use lib 't/lib';
use libmemcached_test;
use Test::More;
-eval "use Cache::Memcached";
-if ($@) {
- plan( skip_all => "Cache::Memcached not available" );
-}
+my $cache = libmemcached_test_create({ min_version => '1.2.4' });
+plan tests => 1;
-my $cache = libmemcached_test_create();
-plan tests => 2;
-
-isa_ok($cache, "Cache::Memcached::libmemcached");
-
-my $cm = Cache::Memcached->new( {
- servers => [ libmemcached_test_servers() ]
-} );
-
-my $h = $cm->stats();
-my $version = $cache->version();
-my ($major, $minor, $micro) = split(/\./, $version);
-my $numified = $major + $minor / 1_000 + $micro / 1_000_000;
-
-SKIP: {
- if ($numified < 1.002004) {
- skip("Remote memcached version is $version, need at least 1.2.4 to run this test", 1);
- }
-
- $cache->set("foo", "abc");
- $cache->prepend("foo", "0123");
- is($cache->get("foo"), "0123abc");
-}
\ No newline at end of file
+$cache->set("foo", "abc");
+$cache->prepend("foo", "0123");
+is($cache->get("foo"), "0123abc");
@@ -3,31 +3,10 @@ use lib 't/lib';
use libmemcached_test;
use Test::More;
-eval "use Cache::Memcached";
-if ($@) {
- plan( skip_all => "Cache::Memcached not available" );
-}
+my $cache = libmemcached_test_create({ min_version => '1.2.4' });
-my $cache = libmemcached_test_create();
-plan(tests => 2);
+plan tests => 1;
-isa_ok($cache, "Cache::Memcached::libmemcached");
-
-my $cm = Cache::Memcached->new( {
- servers => [ libmemcached_test_servers() ]
-} );
-
-my $h = $cm->stats();
-my $version = $cache->version;
-my ($major, $minor, $micro) = split(/\./, $version);
-my $numified = $major + $minor / 1_000 + $micro / 1_000_000;
-
-SKIP: {
- if ($numified < 1.002004) {
- skip("Remote memcached version is $version, need at least 1.2.4 to run this test", 1);
- }
-
- $cache->set("foo", "abc");
- $cache->append("foo", "0123");
- is($cache->get("foo"), "abc0123");
-}
\ No newline at end of file
+$cache->set("foo", "abc");
+$cache->append("foo", "0123");
+is($cache->get("foo"), "abc0123");
@@ -1,58 +1,31 @@
use strict;
+use lib 't/lib';
+use libmemcached_test;
use Test::More;
-plan(skip_all => "cas() unimplemented");
-#BEGIN
-#{
-# eval "use Cache::Memcached";
-# if ($@) {
-# plan( skip_all => "Cache::Memcached not available" );
-# } elsif (! $ENV{ MEMCACHED_SERVER } ) {
-# plan(skip_all => "Define MEMCACHED_SERVER (e.g. localhost:11211) to run this test");
-# } else {
-# plan(tests => 7);
-# }
-# use_ok("Cache::Memcached::libmemcached");
-#}
-#
-#my $cache = Cache::Memcached::libmemcached->new( {
-# servers => [ $ENV{ MEMCACHED_SERVER } ],
-# support_cas => 1,
-#} );
-#
-#isa_ok($cache, "Cache::Memcached::libmemcached");
-#
-## XXX The stats() method is half baked, and you should NOT be using it
-## in your code! DON'T TRUST THIS CODE!
-#
-#my $cm = Cache::Memcached->new( {
-# servers => [ $ENV{ MEMCACHED_SERVER } ],
-#} );
-#my $h = $cm->stats();
-#my $version = $h->{hosts}->{ $ENV{ MEMCACHED_SERVER } }->{misc}->{version};
-#my ($major, $minor, $micro) = split(/\./, $version);
-#my $numified = $major + $minor / 1_000 + $micro / 1_000_000;
-#
-#SKIP: {
-# if ($numified < 1.002004) {
-# skip("Remote memcached version is $version, need at least 1.2.4 to run this test", 1);
-# }
-#
-# my @keys = ('a' .. 'z');
-# $cache->set($_, $_) for @keys;
-# my $cas = $cache->get_cas('a');
-# ok($cas);
-#
-# my $h = $cache->get_cas_multi(@keys);
-# ok($h);
-# isa_ok($h, 'HASH');
-#
-# is($h->{a}, $cas);
-#
-# TODO: {
-# local $TODO = "cas() unconfirmed";
-# my $newvalue = 'this used to be a';
-# $cache->cas('a', $cas, $newvalue);
-# is($cache->get('a'), $newvalue);
-# }
-#}
\ No newline at end of file
+my $cache = libmemcached_test_create({
+ min_version => '1.4.4',
+ behavior_support_cas => 1,
+});
+
+plan skip_all => "cas() unimplemented";
+
+plan tests => 5;
+
+my @keys = ('a' .. 'z');
+$cache->set($_, $_) for @keys;
+my $cas = $cache->get_cas('a');
+ok($cas);
+
+my $h = $cache->get_cas_multi(@keys);
+ok($h);
+isa_ok($h, 'HASH');
+
+is($h->{a}, $cas);
+
+TODO: {
+local $TODO = "cas() unconfirmed";
+my $newvalue = 'this used to be a';
+$cache->cas('a', $cas, $newvalue);
+is($cache->get('a'), $newvalue);
+}
@@ -3,18 +3,19 @@ use lib 't/lib';
use libmemcached_test;
use Test::More;
+my $namespace = "fooblabaz";
-my $cache = libmemcached_test_create( {
- namespace => "fooblabaz",
-} );
+my $cache = libmemcached_test_create( { namespace => $namespace } );
+my $cache_nons = libmemcached_test_create( { } );
-plan(tests => 11);
+plan(tests => 13);
isa_ok($cache, "Cache::Memcached::libmemcached");
{
$cache->set("foo", "bar", 300);
my $val = $cache->get("foo");
is($val, "bar", "simple value");
+ is($cache_nons->get("${namespace}foo"), "bar", "simple value via nons");
}
{
@@ -33,6 +34,7 @@ isa_ok($cache, "Cache::Memcached::libmemcached");
{
ok( $cache->set("foo", 1), "prep for incr" );
is( $cache->incr("foo"), 2, "incr returns 1 more than previous" );
+ is($cache_nons->get("${namespace}foo"), 2, "simple value via nons");
is( $cache->decr("foo"), 1, "decr returns 1 less than previous" );
}
@@ -1,16 +1,10 @@
use strict;
use Test::More;
-BEGIN
-{
- if (! $ENV{TEST_POD}) {
- plan skip_all => "Enable TEST_POD environment variable to test POD";
- } else {
- eval "use Test::Pod::Coverage";
- if ($@) {
- plan skip_all => "Test::Pod::Coverage required for testing pod coverage";
- } else {
- Test::Pod::Coverage::all_pod_coverage_ok();
- }
- }
-}
+plan skip_all => "Enable TEST_POD environment variable to test POD"
+ if not $ENV{TEST_POD} and not -d '.git';
+
+plan skip_all => "Test::Pod::Coverage required for testing pod coverage"
+ if not eval "use Test::Pod::Coverage; 1";
+
+Test::Pod::Coverage::all_pod_coverage_ok();
@@ -1,9 +1,10 @@
-use Test::More;
use strict;
-if (! $ENV{TEST_POD}) {
- plan skip_all => "Enable TEST_POD environment variable to test POD";
-} else {
- eval "use Test::Pod 1.00";
- plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
- Test::Pod::all_pod_files_ok();
-}
+use Test::More;
+
+plan skip_all => "Enable TEST_POD environment variable to test POD"
+ if not $ENV{TEST_POD} and not -d '.git';
+
+plan skip_all => "Test::Pod required for testing pod coverage"
+ if not eval "use Test::Pod; 1";
+
+Test::Pod::all_pod_files_ok();
@@ -26,6 +26,8 @@ sub libmemcached_test_servers {
sub libmemcached_test_create {
my ($args) = @_;
+ my $min_version = delete $args->{min_version};
+
$args->{ servers } = [ libmemcached_test_servers() ];
if ($ENV{LIBMEMCACHED_BINARY_PROTOCOL}) {
@@ -40,30 +42,25 @@ sub libmemcached_test_create {
plan skip_all => "Can't talk to any memcached servers"
if (! defined $value || $time ne $value);
-# plan skip_all => "memcached server version less than $args->{min_version}"
-# if $args->{min_version}
-# && not libmemcached_version_ge($memc, $args->{min_version});
+ plan skip_all => "memcached server version less than $min_version"
+ if $min_version && not libmemcached_version_ge($cache, $min_version);
return $cache;
}
-#sub libmemcached_version_ge {
-# my ($memc, $min_version) = @_;
-# my $numify = sub {
-# my $version = shift;
-# my @version = split /\./, $version;
-# return $version[0] + $version[1] / 100 + $version[2] / 100_000;
-# };
-#
-# my @memcached_version = memcached_version($memc);
-#
-# $min_version = $numify->( $min_version );
-# foreach my $version (map { $numify->($_) } @memcached_version) {
-# return 1 if $version >= $min_version;
-# return 0 if $version < $min_version;
-# }
-# return 1; # identical versions
-#}
+
+sub libmemcached_version_ge {
+ my ($memc, $min_version) = @_;
+ my @min_version = split /\./, $min_version;
+
+ my @memcached_version = $memc->memcached_version;
+
+ for (0,1,2) {
+ return 1 if $memcached_version[$_] > $min_version[$_];
+ return 0 if $memcached_version[$_] < $min_version[$_];
+ }
+ return 1; # identical versions
+}
sub libmemcached_test_key {
@@ -10,12 +10,12 @@ my $no_block = 0;
my $server = '';
my %modes = (
simple_get => 1,
- simple_get_multi => 0,
+ simple_get_multi => 1,
serialize_get => 0,
simple_set => 0,
);
-if (! GetOptions(
+GetOptions(
"no_block!" => \$no_block,
"server=s" => \$server,
"simple-get!" => \$modes{simple_get},
@@ -25,9 +25,10 @@ if (! GetOptions(
"simple-set!" => \$modes{simple_set},
"serialize-set!" => \$modes{serialize_set},
"compress-set!" => \$modes{compress_set},
-)) {
- exit 1;
-}
+) or exit 1;
+
+my $repetitions = shift || 50_000;
+
$server ||= $ENV{MEMCACHED_SERVER} || '127.0.0.1:11211';
print "Module Information:\n";
@@ -37,10 +38,6 @@ foreach my $module qw(Cache::Memcached Cache::Memcached::Fast Cache::Memcached::
}
print "\n";
-print "Library Information:\n";
-print " + libmemcached => @{[ Memcached::libmemcached::memcached_lib_version() ]}\n";
-
-print "\n";
print "Server Information:\n";
{
my $memd = Cache::Memcached::Fast->new({servers => [$server]});
@@ -53,13 +50,6 @@ print "Server Information:\n";
print "\n";
print "Options:\n";
print " + Memcached server: $server\n";
-
-{
- my $memd = Cache::Memcached->new({ servers => [ $server ] });
- my $h = $memd->stats('misc');
- print " + Memcached server version: ", $h->{hosts}{$server}->{misc}->{version}, "\n";
-}
-
print " + Include no block mode (where applicable)? :", $no_block ? "YES" : "NO", "\n";
my %args = (
@@ -75,7 +65,6 @@ my %clients = (
perl_memcached => Cache::Memcached->new(\%args),
memcached_fast => Cache::Memcached::Fast->new(\%args),
libmemcached => Cache::Memcached::libmemcached->new(\%args),
- libmemcached_binary => Cache::Memcached::libmemcached->new({ %args, binary_protocol => 1 }),
memcached_plain => do {
my $memd = Memcached::libmemcached->new();
if ($server =~ /^([^:]+):([^:]+)$/) {
@@ -85,7 +74,13 @@ my %clients = (
}
$memd;
},
- memcached_plain_binary => do {
+);
+
+if (0) {
+ $clients{libmemcached_binary} =
+ Cache::Memcached::libmemcached->new({ %args, binary_protocol => 1 });
+
+ $clients{memcached_plain_binary} = do {
my $memd = Memcached::libmemcached->new();
if ($server =~ /^([^:]+):([^:]+)$/) {
$memd->memcached_server_add($1, $2);
@@ -94,8 +89,8 @@ my %clients = (
}
$memd->memcached_behavior_set( MEMCACHED_BEHAVIOR_BINARY_PROTOCOL, 1 );
$memd;
- }
-);
+ };
+}
# Include non-blocking client modes
if ($no_block) {
@@ -110,17 +105,15 @@ if ($modes{simple_get}) {
print qq|==== Benchmark "Simple get() (scalar)" ====\n|;
$data = '0123456789' x 10;
$clients{perl_memcached}->set( 'foo', $data );
-# $clients{memcached_plain}->memcached_set( 'foo', $data );
- cmpthese(50_000, +{
+ cmpthese($repetitions, +{
map {
my $client = $clients{$_};
($_ => sub {
my $value = ref $client eq 'Memcached::libmemcached' ?
$client->memcached_get('foo') :
$client->get('foo');
- if ($value ne $data) {
- die "$client did not return proper value (wanted '$data', got '$value')"
- }
+ die "$client did not return proper value (wanted '$data', got '$value')"
+ if $value ne $data;
})
} keys %clients
});
@@ -133,7 +126,7 @@ if ($modes{simple_get_multi}) {
for (@keys) {
$clients{perl_memcached}->set($_, $_);
}
- cmpthese(50_000, +{
+ cmpthese($repetitions, +{
map {
my $client = $clients{$_};
$_ => sub { $client->get_multi(@keys) }
@@ -145,7 +138,7 @@ if ($modes{serialize_get}) {
print qq|==== Benchmark "Serialization with get()" ====\n|;
$data = { foo => [ qw(1 2 3) ] };
$clients{perl_memcached}->set( 'foo', $data );
- cmpthese(50_000, {
+ cmpthese($repetitions, {
map {
my $client = $clients{$_};
$_ => sub {
@@ -161,7 +154,7 @@ if ($modes{compress_get}) {
print qq|==== Benchmark "Simple get() (w/compression)" ====\n|;
$data = '0123456789' x 500;
$clients{perl_memcached}->set( 'foo', $data );
- cmpthese(50_000, {
+ cmpthese($repetitions, {
map {
my $client = $clients{$_};
$_ => sub {
@@ -175,7 +168,7 @@ if ($modes{compress_get}) {
if ($modes{simple_set}) {
print qq|==== Benchmark "Simple set() (scalar)" ====\n|;
$data = '0123456789' x 10;
- cmpthese(50_000, {
+ cmpthese($repetitions, {
map {
my $client = $clients{$_};
$_ => sub {
@@ -188,7 +181,7 @@ if ($modes{simple_set}) {
if ($modes{serialize_set}) {
print qq|==== Benchmark "Simple set() (w/seriale)" ====\n|;
$data = { foo => [ qw( 1 2 3 ) ] };
- cmpthese(50_000, {
+ cmpthese($repetitions, {
map {
my $client = $clients{$_};
$_ => sub {
@@ -201,7 +194,7 @@ if ($modes{serialize_set}) {
if ($modes{compress_set}) {
print qq|==== Benchmark "Simple set() (w/compress)" ====\n|;
$data = '0123456789' x 500;
- cmpthese(50_000, {
+ cmpthese($repetitions, {
map {
my $client = $clients{$_};
$_ => sub {