r35538 - in /branches/upstream/libcache-memcached-perl/current: ChangeLog MANIFEST META.yml lib/Cache/Memcached.pm t/01_use.t t/02_keys.t t/03_stats.t t/04_noreply.t t/05_reconnect_timeout.t t/100_flush_bug.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sun May 17 02:55:00 UTC 2009
Author: jawnsy-guest
Date: Sun May 17 02:54:55 2009
New Revision: 35538
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=35538
Log:
[svn-upgrade] Integrating new upstream version, libcache-memcached-perl (1.26)
Added:
branches/upstream/libcache-memcached-perl/current/t/04_noreply.t
branches/upstream/libcache-memcached-perl/current/t/05_reconnect_timeout.t
branches/upstream/libcache-memcached-perl/current/t/100_flush_bug.t
Modified:
branches/upstream/libcache-memcached-perl/current/ChangeLog
branches/upstream/libcache-memcached-perl/current/MANIFEST
branches/upstream/libcache-memcached-perl/current/META.yml
branches/upstream/libcache-memcached-perl/current/lib/Cache/Memcached.pm
branches/upstream/libcache-memcached-perl/current/t/01_use.t
branches/upstream/libcache-memcached-perl/current/t/02_keys.t
branches/upstream/libcache-memcached-perl/current/t/03_stats.t
Modified: branches/upstream/libcache-memcached-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/ChangeLog?rev=35538&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/ChangeLog (original)
+++ branches/upstream/libcache-memcached-perl/current/ChangeLog Sun May 17 02:54:55 2009
@@ -1,3 +1,27 @@
+2009-05-04: version 1.26
+
+ * don't include "stats sizes" by default in the stats method,
+ as that can hang big servers for a few seconds (Brad Fitzpatrick)
+
+2009-05-02: version 1.25
+
+ * Clear @buck2sock when calling disconnect_all. (Dennis Stosberg,
+ [rt.cpan.org #45560]
+
+ * Reconnects to a dead connection shouldn't happen every time when the
+ connection has never succeded. Apply the dead timeout to sockets that
+ never even came up. Add a test.
+
+ * Warn when trying to put undef values into memcache.
+ (Henry Lyne <hlyne at livejournalinc.com>)
+
+ * flush_all now only returns success if there is a proper reply from all
+ servers - Yann Kerherve <yann at sixapart.com>
+
+ * 'noreply' support from Tomash Brechko <tomash.brechko at gmail.com>
+
+ * various test updates from Ronald J Kimball <rkimball at pangeamedia.com>
+
2007-07-17: version 1.24
* update the stats method, including tests for it
Modified: branches/upstream/libcache-memcached-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/MANIFEST?rev=35538&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/MANIFEST (original)
+++ branches/upstream/libcache-memcached-perl/current/MANIFEST Sun May 17 02:54:55 2009
@@ -1,12 +1,15 @@
ChangeLog
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+README
+TODO
lib/Cache/Memcached.pm
lib/Cache/Memcached/GetParser.pm
-Makefile.PL
-README
-MANIFEST
-MANIFEST.SKIP
-TODO
t/01_use.t
t/02_keys.t
t/03_stats.t
+t/04_noreply.t
+t/05_reconnect_timeout.t
+t/100_flush_bug.t
META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libcache-memcached-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/META.yml?rev=35538&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/META.yml (original)
+++ branches/upstream/libcache-memcached-perl/current/META.yml Sun May 17 02:54:55 2009
@@ -1,13 +1,16 @@
-# 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.24
-version_from: lib/Cache/Memcached.pm
-installdirs: site
-requires:
+--- #YAML:1.0
+name: Cache-Memcached
+version: 1.26
+abstract: client library for memcached (memory cache daemon)
+license: ~
+author:
+ - Brad Fitzpatrick <brad at danga.com>
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
Storable: 0
String::CRC32: 0
Time::HiRes: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: branches/upstream/libcache-memcached-perl/current/lib/Cache/Memcached.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/lib/Cache/Memcached.pm?rev=35538&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/lib/Cache/Memcached.pm (original)
+++ branches/upstream/libcache-memcached-perl/current/lib/Cache/Memcached.pm Sun May 17 02:54:55 2009
@@ -1,4 +1,4 @@
-# $Id: Memcached.pm 601 2007-07-17 17:47:33Z bradfitz $
+# $Id: Memcached.pm 811 2009-05-05 01:32:37Z bradfitz $
#
# Copyright (c) 2003, 2004 Brad Fitzpatrick <brad at danga.com>
#
@@ -35,7 +35,7 @@
use constant COMPRESS_SAVINGS => 0.20; # percent
use vars qw($VERSION $HAVE_ZLIB $FLAG_NOSIGNAL);
-$VERSION = "1.24";
+$VERSION = "1.26";
BEGIN {
$HAVE_ZLIB = eval "use Compress::Zlib (); 1;";
@@ -244,6 +244,7 @@
# if a preferred IP is known, try that first.
if ($self && $self->{pref_ip}{$ip}) {
socket($sock, PF_INET, SOCK_STREAM, $proto);
+ $sock_map{$sock} = $host;
my $prefip = $self->{pref_ip}{$ip};
$sin = Socket::sockaddr_in($port,Socket::inet_aton($prefip));
if (_connect_sock($sock,$sin,$self->{connect_timeout})) {
@@ -259,6 +260,7 @@
# normal path, or fallback path if preferred IP failed
unless ($connected) {
socket($sock, PF_INET, SOCK_STREAM, $proto);
+ $sock_map{$sock} = $host;
$sin = Socket::sockaddr_in($port,Socket::inet_aton($ip));
my $timeout = $self ? $self->{connect_timeout} : 0.25;
unless (_connect_sock($sock,$sin,$timeout)) {
@@ -269,6 +271,7 @@
}
} else { # it's a unix domain/local socket
socket($sock, PF_UNIX, SOCK_STREAM, 0);
+ $sock_map{$sock} = $host;
$sin = Socket::sockaddr_un($host);
my $timeout = $self ? $self->{connect_timeout} : 0.25;
unless (_connect_sock($sock,$sin,$timeout)) {
@@ -283,7 +286,6 @@
$| = 1;
select($old);
- $sock_map{$sock} = $host;
$cache_sock{$host} = $sock;
return $sock;
@@ -328,6 +330,7 @@
close $sock;
}
%cache_sock = ();
+ @buck2sock = ();
}
# writes a line, then reads result. by default stops reading after a
@@ -421,7 +424,7 @@
$self->{'stat_callback'}->($stime, $etime, $sock, 'delete');
}
- return $res eq "DELETED\r\n";
+ return defined $res && $res eq "DELETED\r\n";
}
*remove = \&delete;
@@ -457,6 +460,7 @@
$val = Storable::nfreeze($val);
$flags |= F_STORABLE;
}
+ warn "value for memkey:$key is not defined" unless defined $val;
my $len = length($val);
@@ -491,7 +495,7 @@
$self->{'stat_callback'}->($stime, $etime, $sock, $cmdname);
}
- return $res eq "STORED\r\n";
+ return defined $res && $res eq "STORED\r\n";
}
sub incr {
@@ -522,7 +526,7 @@
$self->{'stat_callback'}->($stime, $etime, $sock, $cmdname);
}
- return undef unless $res =~ /^(\d+)/;
+ return undef unless defined $res && $res =~ /^(\d+)/;
return $1;
}
@@ -783,7 +787,7 @@
foreach my $host (@hosts) {
my $sock = $self->sock_to_host($host);
my @res = $self->run_command($sock, "flush_all\r\n");
- $success = 0 unless (@res);
+ $success = 0 unless (scalar @res == 1 && (($res[0] || "") eq "OK\r\n"));
}
return $success;
@@ -815,8 +819,10 @@
# I don't much care what the default is, it should just
# be something reasonable. Obviously "reset" should not
# be on the list :) but other types that might go in here
- # include maps, cachedump, slabs, or items.
- $types = [ qw( misc malloc sizes self ) ];
+ # include maps, cachedump, slabs, or items. Note that
+ # this does NOT include 'sizes' anymore, as that can freeze
+ # bug servers for a couple seconds.
+ $types = [ qw( misc malloc self ) ];
} else {
$types = [ $types ];
}
@@ -894,7 +900,7 @@
HOST: foreach my $host (@{$self->{'buckets'}}) {
my $sock = $self->sock_to_host($host);
my $ok = _write_and_read($self, $sock, "stats reset");
- unless ($ok eq "RESET\r\n") {
+ unless (defined $ok && $ok eq "RESET\r\n") {
_dead_sock($sock);
}
}
Modified: branches/upstream/libcache-memcached-perl/current/t/01_use.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/t/01_use.t?rev=35538&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/t/01_use.t (original)
+++ branches/upstream/libcache-memcached-perl/current/t/01_use.t Sun May 17 02:54:55 2009
@@ -1,7 +1,8 @@
#!/usr/bin/env perl -w
+
use strict;
-use Test;
-BEGIN { plan tests => 1 }
+use Test::More;
-use Cache::Memcached; ok(1);
-exit;
+plan tests => 1;
+
+use_ok('Cache::Memcached');
Modified: branches/upstream/libcache-memcached-perl/current/t/02_keys.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/t/02_keys.t?rev=35538&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/t/02_keys.t (original)
+++ branches/upstream/libcache-memcached-perl/current/t/02_keys.t Sun May 17 02:54:55 2009
@@ -1,4 +1,4 @@
-# -*-perl-*-
+#!/usr/bin/env perl -w
use strict;
use Test::More;
@@ -9,7 +9,7 @@
my $msock = IO::Socket::INET->new(PeerAddr => $testaddr,
Timeout => 3);
if ($msock) {
- plan tests => 10;
+ plan tests => 13;
} else {
plan skip_all => "No memcached instance running at $testaddr\n";
exit 0;
@@ -20,25 +20,27 @@
namespace => "Cache::Memcached::t/$$/" . (time() % 100) . "/",
});
+isa_ok($memd, 'Cache::Memcached');
-ok($memd->set("key1", "val1"), "set succeeded");
+ok($memd->set("key1", "val1"), "set key1 as val1");
-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");
+is($memd->get("key1"), "val1", "get key1 is val1");
+ok(! $memd->add("key1", "val-replace"), "add key1 properly 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 worked");
-ok(! $memd->replace("key-noexist", "bogus"), "replace failed");
+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 properly failed");
-my $stats = $memd->stats;
-ok($stats, "got stats");
-is(ref $stats, "HASH", "is a hashref");
+ok($memd->delete("key1"), "delete key1");
+ok(! $memd->get("key1"), "get key1 properly failed");
-# also make one without a hashref
+# also test creating the object with a list rather than a hash-ref
my $mem2 = Cache::Memcached->new(
servers => [ ],
debug => 1,
- );
+ );
+isa_ok($mem2, 'Cache::Memcached');
ok($mem2->{debug}, "debug is set on alt constructed instance");
Modified: branches/upstream/libcache-memcached-perl/current/t/03_stats.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/t/03_stats.t?rev=35538&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/t/03_stats.t (original)
+++ branches/upstream/libcache-memcached-perl/current/t/03_stats.t Sun May 17 02:54:55 2009
@@ -1,4 +1,4 @@
-# -*-perl-*-
+#!/usr/bin/env perl -w
use strict;
use Test::More;
Added: branches/upstream/libcache-memcached-perl/current/t/04_noreply.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/t/04_noreply.t?rev=35538&op=file
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/t/04_noreply.t (added)
+++ branches/upstream/libcache-memcached-perl/current/t/04_noreply.t Sun May 17 02:54:55 2009
@@ -1,0 +1,52 @@
+#!/usr/bin/env perl -w
+
+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 => 7;
+} 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) . "/",
+});
+
+isa_ok($memd, 'Cache::Memcached');
+
+
+use constant count => 30;
+
+$memd->flush_all;
+
+$memd->add("key", "add");
+is($memd->get("key"), "add");
+
+for (my $i = 0; $i < count; ++$i) {
+ $memd->set("key", $i);
+}
+is($memd->get("key"), count - 1);
+
+$memd->replace("key", count);
+is($memd->get("key"), count);
+
+for (my $i = 0; $i < count; ++$i) {
+ $memd->incr("key", 2);
+}
+is($memd->get("key"), count + 2 * count);
+
+for (my $i = 0; $i < count; ++$i) {
+ $memd->decr("key", 1);
+}
+is($memd->get("key"), count + 1 * count);
+
+$memd->delete("key");
+is($memd->get("key"), undef);
Added: branches/upstream/libcache-memcached-perl/current/t/05_reconnect_timeout.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/t/05_reconnect_timeout.t?rev=35538&op=file
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/t/05_reconnect_timeout.t (added)
+++ branches/upstream/libcache-memcached-perl/current/t/05_reconnect_timeout.t Sun May 17 02:54:55 2009
@@ -1,0 +1,28 @@
+#!/usr/bin/env perl -w
+
+use strict;
+use Test::More;
+use Cache::Memcached;
+use IO::Socket::INET;
+use Time::HiRes;
+
+my $testaddr = "192.0.2.1:11211";
+
+plan tests => 2;
+
+my $memd = Cache::Memcached->new({
+ servers => [ $testaddr ],
+ namespace => "Cache::Memcached::t/$$/" . (time() % 100) . "/",
+});
+
+
+my $time1 = Time::HiRes::time();
+$memd->set("key", "bar");
+my $time2 = Time::HiRes::time();
+# 100ms is faster than the default connect timeout.
+ok($time2 - $time1 > .1, "Expected pause while connecting");
+
+# 100ms should be slow enough that dead socket reconnects happen faster than it.
+$memd->set("key", "foo");
+my $time3 = Time::HiRes::time();
+ok($time3 - $time2 < .1, "Should return fast on retry");
Added: branches/upstream/libcache-memcached-perl/current/t/100_flush_bug.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/t/100_flush_bug.t?rev=35538&op=file
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/t/100_flush_bug.t (added)
+++ branches/upstream/libcache-memcached-perl/current/t/100_flush_bug.t Sun May 17 02:54:55 2009
@@ -1,0 +1,58 @@
+#!/usr/bin/env perl -w
+
+use strict;
+use Test::More;
+use Cache::Memcached;
+use IO::Socket::INET;
+
+my $testaddr = "127.0.0.1:11311";
+my $sock = IO::Socket::INET->new(
+ LocalAddr => $testaddr,
+ Proto => 'tcp',
+ ReusAddr => 1,
+);
+
+my @res = (
+ ["OK\r\n", 1],
+ ["ERROR\r\n", 0],
+ ["\r\nERROR\r\n", 0],
+ ["FOO\r\nERROR\r\n", 0],
+ ["FOO\r\nOK\r\nERROR\r\n", 0],
+ ["\r\n\r\nOK\r\n", 0],
+ ["END\r\n", 0],
+);
+
+if ($sock) {
+ plan tests => scalar @res;
+} else {
+ plan skip_all => "cannot bind to $testaddr\n";
+ exit 0;
+}
+close $sock;
+
+
+my $pid = fork;
+die "Cannot fork because: '$!'" unless defined $pid;
+unless ($pid) {
+ my $sock = IO::Socket::INET->new(
+ LocalAddr => $testaddr,
+ Proto => 'tcp',
+ ReusAddr => 1,
+ Listen => 1,
+ ) or die "cannot open $testaddr: $!";
+ my $csock = $sock->accept();
+ while (defined (my $buf = <$csock>)) {
+ my $res = shift @res;
+ print $csock $res->[0];
+ }
+ close $csock;
+ close $sock;
+ exit 0;
+}
+
+my $memd = Cache::Memcached->new({ servers => [ $testaddr ] });
+
+for (@res) {
+ ($_->[0] =~ s/\W//g);
+ is $memd->flush_all, $_->[1], $_->[0];
+}
More information about the Pkg-perl-cvs-commits
mailing list