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