[patch] Perl Cache::Memcached, stats() and tests
Ronald J Kimball
rkimball+memcached at pangeamedia.com
Tue Jun 19 21:31:26 UTC 2007
After upgrading to Cache::Memcached 1.22, I still get warnings from
calling stats() after a server has been restarted:
Use of uninitialized value in addition (+) at
/usr/share/perl5/Cache/Memcached.pm line 876.
Use of uninitialized value in addition (+) at
/usr/share/perl5/Cache/Memcached.pm line 885.
This is because, although stats() skips the host if the socket is dead,
it still tallies that host's stats for the total stats.
Additionally, stats() tallies each host's misc stats for the total
stats, even when misc stats were not requested (e.g.
$memd->stats('malloc')). This caused warnings and put spurious 0 values
in the stats totals.
The attached patch fixes these issues, by moving the calculation of
total stats into the processing loop.
I also took this opportunity to update the tests for Cache::Memcached:
I renamed use.t to 01_use.t.
I renamed all.t to 02_keys.t and added tests for delete().
I created 03_stats.t to test the results of stats().
The numbers ensure that the test files are run in the appropriate order.
Ronald
-------------- next part --------------
diff -rN -u Cache-Memcached-1.22/MANIFEST Cache-Memcached-1.22.new/MANIFEST
--- Cache-Memcached-1.22/MANIFEST 2007-04-17 02:44:09.000000000 -0400
+++ Cache-Memcached-1.22.new/MANIFEST 2007-06-19 17:22:46.000000000 -0400
@@ -6,6 +6,7 @@
MANIFEST
MANIFEST.SKIP
TODO
-t/use.t
-t/all.t
+t/01_use.t
+t/02_keys.t
+t/03_stats.t
META.yml Module meta-data (added by MakeMaker)
diff -rN -u Cache-Memcached-1.22/lib/Cache/Memcached.pm Cache-Memcached-1.22.new/lib/Cache/Memcached.pm
--- Cache-Memcached-1.22/lib/Cache/Memcached.pm 2007-06-18 13:51:02.000000000 -0400
+++ Cache-Memcached-1.22.new/lib/Cache/Memcached.pm 2007-06-19 17:18:00.000000000 -0400
@@ -820,9 +820,15 @@
$stats_hr->{'self'} = \%{ $self->{'stats'} };
}
+ 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
+ /;
+
# Now handle the other types, passing each type to each host server.
my @hosts = @{$self->{'buckets'}};
- my %malloc_keys = ( );
HOST: foreach my $host (@hosts) {
my $sock = $self->sock_to_host($host);
TYPE: foreach my $typename (grep !/^self$/, @$types) {
@@ -852,7 +858,10 @@
if ($key) {
$stats_hr->{'hosts'}{$host}{$typename}{$key} = $value;
}
- $malloc_keys{$key} = 1 if $key && $typename eq 'malloc';
+ $stats_hr->{'total'}{$key} += $value
+ if $typename eq 'misc' && $key && $misc_keys{$key};
+ $stats_hr->{'total'}{"malloc_$key"} += $value
+ if $typename eq 'malloc' && $key;
}
} else {
# This stat is not key-value so just pull it
@@ -864,29 +873,6 @@
}
}
- # Now get the sum total of applicable values. First the misc values.
- foreach my $stat (qw(
- bytes bytes_read bytes_written
- cmd_get cmd_set connection_structures curr_items
- get_hits get_misses
- total_connections total_items
- )) {
- $stats_hr->{'total'}{$stat} = 0;
- foreach my $host (@hosts) {
- $stats_hr->{'total'}{$stat} +=
- $stats_hr->{'hosts'}{$host}{'misc'}{$stat};
- }
- }
-
- # Then all the malloc values, if any.
- foreach my $malloc_stat (keys %malloc_keys) {
- $stats_hr->{'total'}{"malloc_$malloc_stat"} = 0;
- foreach my $host (@hosts) {
- $stats_hr->{'total'}{"malloc_$malloc_stat"} +=
- $stats_hr->{'hosts'}{$host}{'malloc'}{$malloc_stat};
- }
- }
-
return $stats_hr;
}
diff -rN -u Cache-Memcached-1.22/t/01_use.t Cache-Memcached-1.22.new/t/01_use.t
--- Cache-Memcached-1.22/t/01_use.t 1969-12-31 19:00:00.000000000 -0500
+++ Cache-Memcached-1.22.new/t/01_use.t 2006-03-23 13:39:36.000000000 -0500
@@ -0,0 +1,7 @@
+#!/usr/bin/env perl -w
+use strict;
+use Test;
+BEGIN { plan tests => 1 }
+
+use Cache::Memcached; ok(1);
+exit;
diff -rN -u Cache-Memcached-1.22/t/02_keys.t Cache-Memcached-1.22.new/t/02_keys.t
--- Cache-Memcached-1.22/t/02_keys.t 1969-12-31 19:00:00.000000000 -0500
+++ Cache-Memcached-1.22.new/t/02_keys.t 2007-06-19 16:56:26.000000000 -0400
@@ -0,0 +1,35 @@
+# -*-perl-*-
+
+use strict;
+use Test::More;
+use Cache::Memcached;
+use IO::Socket::INET;
+
+my $testaddr = "127.0.0.1:11211";
+my $msock = IO::Socket::INET->new(PeerAddr => $testaddr,
+ Timeout => 3);
+if ($msock) {
+ plan tests => 10;
+} else {
+ plan skip_all => "No memcached instance running at $testaddr\n";
+ exit 0;
+}
+
+my $memd = Cache::Memcached->new({
+ servers => [ $testaddr ],
+ namespace => "Cache::Memcached::t/$$/" . (time() % 100) . "/",
+});
+
+ok($memd->set("key1", "val1"), "set key1 as val1");
+
+is($memd->get("key1"), "val1", "get key1 is val1");
+ok(! $memd->add("key1", "val-replace"), "add key1 failed");
+ok($memd->add("key2", "val2"), "add key2 as val2");
+is($memd->get("key2"), "val2", "get key2 is val2");
+
+ok($memd->replace("key2", "val-replace"), "replace key2 as val-replace");
+is($memd->get("key2"), "val-replace", "get key2 is val-replace");
+ok(! $memd->replace("key-noexist", "bogus"), "replace key-noexist failed");
+
+ok($memd->delete("key1"), "delete key1");
+ok(! $memd->get("key1"), "get key1 failed");
diff -rN -u Cache-Memcached-1.22/t/03_stats.t Cache-Memcached-1.22.new/t/03_stats.t
--- Cache-Memcached-1.22/t/03_stats.t 1969-12-31 19:00:00.000000000 -0500
+++ Cache-Memcached-1.22.new/t/03_stats.t 2007-06-19 16:58:13.000000000 -0400
@@ -0,0 +1,78 @@
+# -*-perl-*-
+
+use strict;
+use Test::More;
+use Cache::Memcached;
+use IO::Socket::INET;
+
+my $testaddr = "127.0.0.1:11211";
+my $msock = IO::Socket::INET->new(PeerAddr => $testaddr,
+ Timeout => 3);
+
+my @misc_stats_keys = qw/ bytes bytes_read bytes_written
+ cmd_get cmd_set connection_structures curr_items
+ get_hits get_misses
+ total_connections total_items
+ /;
+
+if ($msock) {
+ plan tests => 24 + scalar(@misc_stats_keys);
+} else {
+ plan skip_all => "No memcached instance running at $testaddr\n";
+ exit 0;
+}
+
+my $memd = Cache::Memcached->new({
+ servers => [ $testaddr ],
+ namespace => "Cache::Memcached::t/$$/" . (time() % 100) . "/",
+});
+
+my $misc_stats = $memd->stats('misc');
+ok($misc_stats, 'got misc stats');
+isa_ok($misc_stats, 'HASH', 'misc stats');
+isa_ok($misc_stats->{'total'}, 'HASH', 'misc stats total');
+isa_ok($misc_stats->{'hosts'}, 'HASH', 'misc stats hosts');
+isa_ok($misc_stats->{'hosts'}{$testaddr}, 'HASH',
+ "misc stats hosts $testaddr");
+
+foreach my $stat_key (@misc_stats_keys) {
+ ok(exists $misc_stats->{'total'}{$stat_key},
+ "misc stats total contains $stat_key");
+ ok(exists $misc_stats->{'hosts'}{$testaddr}{'misc'}{$stat_key},
+ "misc stats hosts $testaddr misc contains $stat_key");
+}
+
+my $got_malloc = 0;
+foreach my $stat_key (keys %{$misc_stats->{'total'}}) {
+ if ($stat_key =~ /^malloc/) {
+ $got_malloc = 1;
+ last;
+ }
+}
+ok(! $got_malloc, 'no malloc stats in misc stats');
+
+my $malloc_stats = $memd->stats('malloc');
+ok($malloc_stats, 'got malloc stats');
+isa_ok($malloc_stats, 'HASH', 'malloc stats');
+isa_ok($malloc_stats->{'total'}, 'HASH', 'malloc stats total');
+isa_ok($misc_stats->{'hosts'}, 'HASH', 'malloc stats hosts');
+isa_ok($misc_stats->{'hosts'}{$testaddr}, 'HASH',
+ "malloc stats host $testaddr");
+
+$got_malloc = 0;
+foreach my $stat_key (keys %{$malloc_stats->{'total'}}) {
+ if ($stat_key =~ /^malloc/) {
+ $got_malloc = 1;
+ last;
+ }
+}
+ok($got_malloc, 'malloc stats in malloc stats');
+
+my $got_misc = 0;
+foreach my $stat_key (@misc_stats_keys) {
+ if (exists $malloc_stats->{'total'}{$stat_key}) {
+ $got_misc = 1;
+ last;
+ }
+}
+ok(! $got_misc, 'no misc stats in malloc stats');
diff -rN -u Cache-Memcached-1.22/t/all.t Cache-Memcached-1.22.new/t/all.t
--- Cache-Memcached-1.22/t/all.t 2006-04-30 04:53:37.000000000 -0400
+++ Cache-Memcached-1.22.new/t/all.t 1969-12-31 19:00:00.000000000 -0500
@@ -1,38 +0,0 @@
-# -*-perl-*-
-
-use strict;
-use Test::More;
-use Cache::Memcached;
-use IO::Socket::INET;
-
-my $testaddr = "127.0.0.1:11211";
-my $msock = IO::Socket::INET->new(PeerAddr => $testaddr,
- Timeout => 3);
-if ($msock) {
- plan tests => 9;
-} else {
- plan skip_all => "No memcached instance running at $testaddr\n";
- exit 0;
-}
-
-my $memd = Cache::Memcached->new({
- servers => [ $testaddr ],
- namespace => "Cache::Memcached::t/$$/" . (time() % 100) . "/",
-});
-
-ok($memd->set("key1", "val1"), "set succeeded");
-
-is($memd->get("key1"), "val1", "get worked");
-ok(! $memd->add("key1", "val-replace"), "add properly failed");
-ok($memd->add("key2", "val2"), "add worked on key2");
-is($memd->get("key2"), "val2", "get worked");
-
-ok($memd->replace("key2", "val-replace"), "replace worked");
-ok(! $memd->replace("key-noexist", "bogus"), "replace failed");
-
-my $stats = $memd->stats;
-ok($stats, "got stats");
-is(ref $stats, "HASH", "is a hashref");
-
-
-
diff -rN -u Cache-Memcached-1.22/t/use.t Cache-Memcached-1.22.new/t/use.t
--- Cache-Memcached-1.22/t/use.t 2006-03-23 13:39:36.000000000 -0500
+++ Cache-Memcached-1.22.new/t/use.t 1969-12-31 19:00:00.000000000 -0500
@@ -1,7 +0,0 @@
-#!/usr/bin/env perl -w
-use strict;
-use Test;
-BEGIN { plan tests => 1 }
-
-use Cache::Memcached; ok(1);
-exit;
More information about the memcached
mailing list