[PATCH] fix stats() in Cache::Memcached
Shiar
memcached at shiar.org
Tue Sep 28 03:47:25 PDT 2004
Couldn't get the stats() command in the perl api to work. It assumed
_oneline() returns a single line, while it usually got the whole blurb.
I don't know what it's supposed to do, but at least run_command() assumes the
latter. Also, since run_command() is quite similar, I used that function in
stats() to reduce code duplication. All in all, I think this code is cleaner,
but mainly: it just Works For Me (tm).
At least one point I'm not sure though: there was a comment saying some
commands used \n as line end instead of \r\n, and one saying 'stats sizes'
started with \0. I couldn't reproduce either, so I assume this is only the
case on older servers? Should these be supported? I left some comments
inthere just in case.
--
Shiar - http://www.shiar.org
> Nur tiu ne eraras, kiu neniam ion faras
-------------- next part --------------
--- Memcached.pm.old Tue Jul 27 19:07:04 2004
+++ Memcached.pm Mon Sep 27 16:01:18 2004
@@ -752,11 +752,15 @@
my $line = $cmd;
while (my $res = _oneline($self, $sock, $line)) {
undef $line;
- $ret .= $res;
+ $ret .= $res;
last if $ret =~ /(?:END|ERROR)\r\n$/;
}
- chop $ret; chop $ret;
- return map { "$_\r\n" } split(/\r\n/, $ret);
+ # Remove trailing linebreaks.
+ # Was double chop $ret, but just to be safe:
+ $ret =~ s/\r?\n$//;
+ # Each line should end in \r\n.
+ # If this is not the case, maybe we should use /\r?\n/?
+ return split(/\r\n/, $ret);
}
sub stats {
@@ -792,49 +796,44 @@
HOST: foreach my $host (@hosts) {
my $sock = $self->sock_to_host($host);
TYPE: foreach my $typename (grep !/^self$/, @$types) {
- my $type = $typename eq 'misc' ? "" : " $typename";
- my $line = _oneline($self, $sock, "stats$type\r\n");
- if (!$line) {
- _dead_sock($sock);
- next HOST;
- }
-
# Some stats are key-value, some are not. malloc,
# sizes, and the empty string are key-value.
# ("self" was handled separately above.)
- if ($typename =~ /^(malloc|sizes|misc)$/) {
+ if ($typename =~ /^(malloc|sizes|misc|slabs|items)$/) {
# This stat is key-value.
- LINE: while ($line) {
- # We have to munge this data a little. First, I'm not
- # sure why, but 'stats sizes' output begins with NUL.
- $line =~ s/^\0//;
-
- # And, most lines end in \r\n but 'stats maps' (as of
- # July 2003 at least) ends in \n. An alternative
- # would be { local $/="\r\n"; chomp } but this works
- # just as well:
- $line =~ s/[\r\n]+$//;
- # OK, process the data until the end, converting it
+ my $type = $typename eq 'misc' ? "" : " $typename";
+
+ # Get array of every line (seperator should always be \r\n).
+ # Previous split was /[\r\n]+/, because 'stats maps' could
+ # apparantly end in \n (as of July 2003 according to earlier
+ # comment). This does not appear to be the case anymore though.
+ my @line = run_command($self, $sock, "stats$type\r\n") or next HOST;
+
+ # Also, comment said 'stats sizes' output started with NUL. Also gone?
+ #s/^\0// for @line;
+
+ for my $line (@line) {
+ # Process the data until the end, converting it
# into its key-value pairs.
- last LINE if $line eq 'END';
- my($key, $value) = $line =~ /^(?:STAT )?(\w+)\s(.*)/;
- if ($key) {
- $stats_hr->{'hosts'}{$host}{$typename}{$key} = $value;
- }
+ last if $line eq 'END' or $line eq 'ERROR';
+ my($key, $value) = $line =~ /^(?:STAT )?(\S+)\s(.*)/o;
+ $stats_hr->{'hosts'}{$host}{$typename}{$key} = $value if $key;
$malloc_keys{$key} = 1 if $typename eq 'malloc';
-
- # read the next line
- $line = _oneline($self, $sock);
}
} else {
# This stat is not key-value so just pull it
# all out in one blob.
- LINE: while ($line) {
- $line =~ s/[\r\n]+$//;
- last LINE if $line eq 'END';
+
+ my $line = _oneline($self, $sock, "stats$typename\r\n");
+ next HOST unless $line;
+
+ while ($line) {
+ # Check for end mark, and remove from result.
+ my $lastline = $line =~ s/END\r?\n$//;
$stats_hr->{'hosts'}{$host}{$typename} ||= "";
- $stats_hr->{'hosts'}{$host}{$typename} .= "$line\n";
+ $stats_hr->{'hosts'}{$host}{$typename} .= $line;
+ last if $lastline;
# read the next one
$line = _oneline($self, $sock);
More information about the memcached
mailing list