r11370 - in /trunk/libcache-memcached-perl: ChangeLog MANIFEST META.yml debian/changelog lib/Cache/Memcached.pm t/01_use.t t/02_keys.t t/03_stats.t t/all.t t/use.t
jeremiah-guest at users.alioth.debian.org
jeremiah-guest at users.alioth.debian.org
Tue Dec 18 12:19:08 UTC 2007
Author: jeremiah-guest
Date: Tue Dec 18 12:19:08 2007
New Revision: 11370
URL: http://svn.debian.org/wsvn/?sc=1&rev=11370
Log:
* New upstream release closes two bugs.
Added:
trunk/libcache-memcached-perl/t/01_use.t
- copied unchanged from r11369, branches/upstream/libcache-memcached-perl/current/t/01_use.t
trunk/libcache-memcached-perl/t/02_keys.t
- copied unchanged from r11369, branches/upstream/libcache-memcached-perl/current/t/02_keys.t
trunk/libcache-memcached-perl/t/03_stats.t
- copied unchanged from r11369, branches/upstream/libcache-memcached-perl/current/t/03_stats.t
Removed:
trunk/libcache-memcached-perl/t/all.t
trunk/libcache-memcached-perl/t/use.t
Modified:
trunk/libcache-memcached-perl/ChangeLog
trunk/libcache-memcached-perl/MANIFEST
trunk/libcache-memcached-perl/META.yml
trunk/libcache-memcached-perl/debian/changelog
trunk/libcache-memcached-perl/lib/Cache/Memcached.pm
Modified: trunk/libcache-memcached-perl/ChangeLog
URL: http://svn.debian.org/wsvn/trunk/libcache-memcached-perl/ChangeLog?rev=11370&op=diff
==============================================================================
--- trunk/libcache-memcached-perl/ChangeLog (original)
+++ trunk/libcache-memcached-perl/ChangeLog Tue Dec 18 12:19:08 2007
@@ -1,3 +1,34 @@
+2007-07-17: version 1.24
+
+ * update the stats method, including tests for it
+ (Ronald J Kimball <rkimball+memcached at pangeamedia.com>)
+
+ * arguments to 'new' constructor can be %hash or $hashref now
+ (previously was only $hashref)
+
+ * work around a Perl segfault (Matthieu PATOU <mp at oxado.com>)
+ see http://lists.danga.com/pipermail/memcached/2007-June/004511.html
+
+2007-06-19: version 1.23
+
+ * add 'remove' as an alias for 'delete' (Dave Cardwell <dave at davecardwell.co.uk>)
+
+2007-06-18: version 1.22
+
+ * lost connection handling broken due to wrong %sock_map indexing
+ http://rt.cpan.org/Public/Bug/Display.html?id=27181
+ fix from RHESA
+
+ * let parser_class be configured as a constructor option,
+ defaulting to XS if available, else regular. (unless
+ $ENV{NO_XS} is set, in which case the default is regular)
+
+2007-05-02: version 1.21
+
+ * new faster optional interface for GetParser subclasses. doing
+ this release so upcoming Cache::Memcached::GetParserXS can
+ depend on this. otherwise this release isn't interesting.
+
2007-04-16: version 1.20
* fix "Warning produced when flush_all called" from CDENT
Modified: trunk/libcache-memcached-perl/MANIFEST
URL: http://svn.debian.org/wsvn/trunk/libcache-memcached-perl/MANIFEST?rev=11370&op=diff
==============================================================================
--- trunk/libcache-memcached-perl/MANIFEST (original)
+++ trunk/libcache-memcached-perl/MANIFEST Tue Dec 18 12:19:08 2007
@@ -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)
Modified: trunk/libcache-memcached-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libcache-memcached-perl/META.yml?rev=11370&op=diff
==============================================================================
--- trunk/libcache-memcached-perl/META.yml (original)
+++ trunk/libcache-memcached-perl/META.yml Tue Dec 18 12:19:08 2007
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Cache-Memcached
-version: 1.20
+version: 1.24
version_from: lib/Cache/Memcached.pm
installdirs: site
requires:
Modified: trunk/libcache-memcached-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libcache-memcached-perl/debian/changelog?rev=11370&op=diff
==============================================================================
--- trunk/libcache-memcached-perl/debian/changelog (original)
+++ trunk/libcache-memcached-perl/debian/changelog Tue Dec 18 12:19:08 2007
@@ -1,4 +1,11 @@
-libcache-memcached-perl (1.20-2) UNRELEASED; urgency=low
+libcache-memcached-perl (1.24-1) UNRELEASED; urgency=low
+
+ * New upstream release (Closes: #454264)
+ * (No other changes)
+
+ -- Jeremiah C. Foster <jeremiah at jeremiahfoster.com> Tue, 18 Dec 2007 13:17:20 +0100
+
+libcache-memcached-perl (1.20-2) unstable; urgency=low
* debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
field (source stanza); Homepage field (source stanza).
Modified: trunk/libcache-memcached-perl/lib/Cache/Memcached.pm
URL: http://svn.debian.org/wsvn/trunk/libcache-memcached-perl/lib/Cache/Memcached.pm?rev=11370&op=diff
==============================================================================
--- trunk/libcache-memcached-perl/lib/Cache/Memcached.pm (original)
+++ trunk/libcache-memcached-perl/lib/Cache/Memcached.pm Tue Dec 18 12:19:08 2007
@@ -1,4 +1,4 @@
-# $Id: Memcached.pm 517 2007-04-17 06:46:55Z bradfitz $
+# $Id: Memcached.pm 601 2007-07-17 17:47:33Z bradfitz $
#
# Copyright (c) 2003, 2004 Brad Fitzpatrick <brad at danga.com>
#
@@ -8,6 +8,8 @@
package Cache::Memcached;
use strict;
+use warnings;
+
no strict 'refs';
use Storable ();
use Socket qw( MSG_NOSIGNAL PF_INET PF_UNIX IPPROTO_TCP SOCK_STREAM );
@@ -16,20 +18,13 @@
use String::CRC32;
use Errno qw( EINPROGRESS EWOULDBLOCK EISCONN );
use Cache::Memcached::GetParser;
-my $HAVE_XS = eval "use Cache::Memcached::GetParserXS; 1;";
-$HAVE_XS = 0 if $ENV{NO_XS};
-
-my $parser_class = $HAVE_XS ? "Cache::Memcached::GetParserXS" : "Cache::Memcached::GetParser";
-if ($ENV{XS_DEBUG}) {
- print "using parser: $parser_class\n";
-}
-
use fields qw{
debug no_rehash stats compress_threshold compress_enable stat_callback
readonly select_timeout namespace namespace_len servers active buckets
pref_ip
bucketcount _single_sock _stime
connect_timeout cb_connect_fail
+ parser_class
};
# flag definitions
@@ -40,10 +35,18 @@
use constant COMPRESS_SAVINGS => 0.20; # percent
use vars qw($VERSION $HAVE_ZLIB $FLAG_NOSIGNAL);
-$VERSION = "1.20";
+$VERSION = "1.24";
BEGIN {
$HAVE_ZLIB = eval "use Compress::Zlib (); 1;";
+}
+
+my $HAVE_XS = eval "use Cache::Memcached::GetParserXS; 1;";
+$HAVE_XS = 0 if $ENV{NO_XS};
+
+my $parser_class = $HAVE_XS ? "Cache::Memcached::GetParserXS" : "Cache::Memcached::GetParser";
+if ($ENV{XS_DEBUG}) {
+ print "using parser: $parser_class\n";
}
$FLAG_NOSIGNAL = 0;
@@ -61,7 +64,7 @@
my Cache::Memcached $self = shift;
$self = fields::new( $self ) unless ref $self;
- my ($args) = @_;
+ my $args = (@_ == 1) ? shift : { @_ }; # hashref-ify args
$self->set_servers($args->{'servers'});
$self->{'debug'} = $args->{'debug'} || 0;
@@ -72,6 +75,7 @@
$self->{'compress_enable'} = 1;
$self->{'stat_callback'} = $args->{'stat_callback'} || undef;
$self->{'readonly'} = $args->{'readonly'};
+ $self->{'parser_class'} = $args->{'parser_class'} || $parser_class;
# TODO: undocumented
$self->{'connect_timeout'} = $args->{'connect_timeout'} || 0.25;
@@ -156,16 +160,16 @@
$self->{'stat_callback'} = $stat_callback;
}
-my %sock_map; # scalaraddr -> "$ip:$port";
+my %sock_map; # stringified-$sock -> "$ip:$port"
sub _dead_sock {
my ($sock, $ret, $dead_for) = @_;
- if (my $ipport = $sock_map{\$sock}) {
+ if (my $ipport = $sock_map{$sock}) {
my $now = time();
$host_dead{$ipport} = $now + $dead_for
if $dead_for;
delete $cache_sock{$ipport};
- delete $sock_map{\$sock};
+ delete $sock_map{$sock};
}
@buck2sock = ();
return $ret; # 0 or undef, probably, depending on what caller wants
@@ -173,10 +177,10 @@
sub _close_sock {
my ($sock) = @_;
- if (my $ipport = $sock_map{\$sock}) {
+ if (my $ipport = $sock_map{$sock}) {
close $sock;
delete $cache_sock{$ipport};
- delete $sock_map{\$sock};
+ delete $sock_map{$sock};
}
@buck2sock = ();
}
@@ -398,7 +402,6 @@
return $ret;
}
-
sub delete {
my Cache::Memcached $self = shift;
my ($key, $time) = @_;
@@ -420,6 +423,7 @@
return $res eq "DELETED\r\n";
}
+*remove = \&delete;
sub add {
_set("add", @_);
@@ -544,7 +548,9 @@
if ($self->{'_single_sock'}) {
$sock = $self->sock_to_host($self->{'_single_sock'});
- return {} unless $sock;
+ unless ($sock) {
+ return {};
+ }
foreach my $key (@_) {
my $kval = ref $key ? $key->[1] : $key;
push @{$sock_keys{$sock}}, $kval;
@@ -561,8 +567,18 @@
my $tries;
while (1) {
my $bucket = $hv % $bcount;
- $sock = $buck2sock[$bucket] ||= $self->sock_to_host($self->{buckets}[ $bucket ])
- and last;
+
+ # this segfaults perl 5.8.4 (and others?) if sock_to_host returns undef... wtf?
+ #$sock = $buck2sock[$bucket] ||= $self->sock_to_host($self->{buckets}[ $bucket ])
+ # and last;
+
+ # but this variant doesn't crash:
+ $sock = $buck2sock[$bucket] || $self->sock_to_host($self->{buckets}[ $bucket ]);
+ if ($sock) {
+ $buck2sock[$bucket] = $sock;
+ last;
+ }
+
next KEY if $tries++ >= 20;
$hv += _hashfunc($tries . $real_key);
}
@@ -622,25 +638,31 @@
_dead_sock($sock);
};
+ # $finalize->($key, $flags)
+ # $finalize->({ $key => $flags, $key => $flags });
my $finalize = sub {
- my ($k, $flags) = @_;
-
- # remove trailing \r\n
- chop $ret->{$k}; chop $ret->{$k};
-
- $ret->{$k} = Compress::Zlib::memGunzip($ret->{$k})
- if $HAVE_ZLIB && $flags & F_COMPRESS;
- if ($flags & F_STORABLE) {
- # wrapped in eval in case a perl 5.6 Storable tries to
- # unthaw data from a perl 5.8 Storable. (5.6 is stupid
- # and dies if the version number changes at all. in 5.8
- # they made it only die if it unencounters a new feature)
- eval {
- $ret->{$k} = Storable::thaw($ret->{$k});
- };
- # so if there was a problem, just treat it as a cache miss.
- if ($@) {
- delete $ret->{$k};
+ my $map = $_[0];
+ $map = {@_} unless ref $map;
+
+ while (my ($k, $flags) = each %$map) {
+
+ # remove trailing \r\n
+ chop $ret->{$k}; chop $ret->{$k};
+
+ $ret->{$k} = Compress::Zlib::memGunzip($ret->{$k})
+ if $HAVE_ZLIB && $flags & F_COMPRESS;
+ if ($flags & F_STORABLE) {
+ # wrapped in eval in case a perl 5.6 Storable tries to
+ # unthaw data from a perl 5.8 Storable. (5.6 is stupid
+ # and dies if the version number changes at all. in 5.8
+ # they made it only die if it unencounters a new feature)
+ eval {
+ $ret->{$k} = Storable::thaw($ret->{$k});
+ };
+ # so if there was a problem, just treat it as a cache miss.
+ if ($@) {
+ delete $ret->{$k};
+ }
}
}
};
@@ -656,7 +678,7 @@
$buf{$_} = join(" ", 'get', @{$sock_keys->{$_}}, "\r\n");
}
- $parser{$_} = $parser_class->new($ret, $self->{namespace_len}, $finalize);
+ $parser{$_} = $self->{parser_class}->new($ret, $self->{namespace_len}, $finalize);
}
my $read = sub {
@@ -808,9 +830,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) {
@@ -840,7 +868,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
@@ -852,29 +883,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;
}
@@ -892,8 +900,6 @@
}
return 1;
}
-
-
1;
__END__
@@ -1063,6 +1069,9 @@
(Sometimes useful as a hacky means to prevent races.) Returns true if key
was found and deleted, and false otherwise.
+You may also use the alternate method name B<remove>, so
+Cache::Memcached looks like the L<Cache::Cache> API.
+
=item C<incr>
$memd->incr($key[, $value]);
More information about the Pkg-perl-cvs-commits
mailing list