r44692 - in /branches/upstream/libcache-memcached-perl/current: ChangeLog MANIFEST META.yml lib/Cache/Memcached.pm t/02_keys.t t/03_stats.t t/06_utf8_key.t t/100_flush_bug.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed Sep 23 23:13:12 UTC 2009
Author: jawnsy-guest
Date: Wed Sep 23 23:13:06 2009
New Revision: 44692
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=44692
Log:
[svn-upgrade] Integrating new upstream version, libcache-memcached-perl (1.27)
Added:
branches/upstream/libcache-memcached-perl/current/t/06_utf8_key.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/02_keys.t
branches/upstream/libcache-memcached-perl/current/t/03_stats.t
branches/upstream/libcache-memcached-perl/current/t/100_flush_bug.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=44692&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/ChangeLog (original)
+++ branches/upstream/libcache-memcached-perl/current/ChangeLog Wed Sep 23 23:13:06 2009
@@ -1,3 +1,13 @@
+2009-09-22: version 1.27
+
+ * Fix get() with utf-8 keys (athomason)
+
+ * "stats malloc" command is gone in 1.4; remove those tests (athomason)
+
+ * Add append/prepend support (dormando)
+
+ * Fix occasional failure in the 100_flush_bug.t test (Ask Bjørn Hansen)
+
2009-05-04: version 1.26
* don't include "stats sizes" by default in the stats method,
Modified: branches/upstream/libcache-memcached-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/MANIFEST?rev=44692&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/MANIFEST (original)
+++ branches/upstream/libcache-memcached-perl/current/MANIFEST Wed Sep 23 23:13:06 2009
@@ -11,5 +11,6 @@
t/03_stats.t
t/04_noreply.t
t/05_reconnect_timeout.t
+t/06_utf8_key.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=44692&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/META.yml (original)
+++ branches/upstream/libcache-memcached-perl/current/META.yml Wed Sep 23 23:13:06 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Cache-Memcached
-version: 1.26
+version: 1.27
abstract: client library for memcached (memory cache daemon)
license: ~
author:
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=44692&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/lib/Cache/Memcached.pm (original)
+++ branches/upstream/libcache-memcached-perl/current/lib/Cache/Memcached.pm Wed Sep 23 23:13:06 2009
@@ -1,4 +1,4 @@
-# $Id: Memcached.pm 811 2009-05-05 01:32:37Z bradfitz $
+# $Id: Memcached.pm 827 2009-09-22 05:29:08Z bradfitz $
#
# Copyright (c) 2003, 2004 Brad Fitzpatrick <brad at danga.com>
#
@@ -18,6 +18,7 @@
use String::CRC32;
use Errno qw( EINPROGRESS EWOULDBLOCK EISCONN );
use Cache::Memcached::GetParser;
+use Encode ();
use fields qw{
debug no_rehash stats compress_threshold compress_enable stat_callback
readonly select_timeout namespace namespace_len servers active buckets
@@ -35,7 +36,7 @@
use constant COMPRESS_SAVINGS => 0.20; # percent
use vars qw($VERSION $HAVE_ZLIB $FLAG_NOSIGNAL);
-$VERSION = "1.26";
+$VERSION = "1.27";
BEGIN {
$HAVE_ZLIB = eval "use Compress::Zlib (); 1;";
@@ -440,6 +441,14 @@
_set("set", @_);
}
+sub append {
+ _set("append", @_);
+}
+
+sub prepend {
+ _set("prepend", @_);
+}
+
sub _set {
my $cmdname = shift;
my Cache::Memcached $self = shift;
@@ -451,11 +460,13 @@
use bytes; # return bytes from length()
+ my $app_or_prep = $cmdname eq 'append' || $cmdname eq 'prepend' ? 1 : 0;
$self->{'stats'}->{$cmdname}++;
my $flags = 0;
$key = ref $key ? $key->[1] : $key;
if (ref $val) {
+ die "append or prepend cannot take a reference" if $app_or_prep;
local $Carp::CarpLevel = 2;
$val = Storable::nfreeze($val);
$flags |= F_STORABLE;
@@ -465,7 +476,7 @@
my $len = length($val);
if ($self->{'compress_threshold'} && $HAVE_ZLIB && $self->{'compress_enable'} &&
- $len >= $self->{'compress_threshold'}) {
+ $len >= $self->{'compress_threshold'} && !$app_or_prep) {
my $c_val = Compress::Zlib::memGzip($val);
my $c_len = length($c_val);
@@ -537,6 +548,11 @@
# TODO: make a fast path for this? or just keep using get_multi?
my $r = $self->get_multi($key);
my $kval = ref $key ? $key->[1] : $key;
+
+ # key reconstituted from server won't have utf8 on, so turn it off on input
+ # scalar to allow hash lookup to succeed
+ Encode::_utf8_off($kval) if Encode::is_utf8($kval);
+
return $r->{$kval};
}
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=44692&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/t/02_keys.t (original)
+++ branches/upstream/libcache-memcached-perl/current/t/02_keys.t Wed Sep 23 23:13:06 2009
@@ -5,11 +5,16 @@
use Cache::Memcached;
use IO::Socket::INET;
+unless ($^V) {
+ plan skip_all => "This test requires perl 5.6.0+\n";
+ exit 0;
+}
+
my $testaddr = "127.0.0.1:11211";
my $msock = IO::Socket::INET->new(PeerAddr => $testaddr,
Timeout => 3);
if ($msock) {
- plan tests => 13;
+ plan tests => 20;
} else {
plan skip_all => "No memcached instance running at $testaddr\n";
exit 0;
@@ -21,6 +26,18 @@
});
isa_ok($memd, 'Cache::Memcached');
+
+my $memcached_version;
+
+eval {
+ require version;
+ die "version too old" unless $version::VERSION >= 0.77;
+ $memcached_version =
+ version->parse(
+ $memd->stats('misc')->{hosts}->{$testaddr}->{misc}->{version}
+ );
+ diag("Server version: $memcached_version") if $memcached_version;
+};
ok($memd->set("key1", "val1"), "set key1 as val1");
@@ -36,6 +53,20 @@
ok($memd->delete("key1"), "delete key1");
ok(! $memd->get("key1"), "get key1 properly failed");
+SKIP: {
+ skip "Could not parse server version; version.pm 0.77 required", 7
+ unless $memcached_version;
+ skip "Only using prepend/append on memcached >= 1.2.4, you have $memcached_version", 7
+ unless $memcached_version && $memcached_version >= v1.2.4;
+
+ ok(! $memd->append("key-noexist", "bogus"), "append key-noexist properly failed");
+ ok(! $memd->prepend("key-noexist", "bogus"), "prepend key-noexist properly failed");
+ ok($memd->set("key3", "base"), "set key3 to base");
+ ok($memd->append("key3", "-end"), "appended -end to key3");
+ ok($memd->get("key3", "base-end"), "key3 is base-end");
+ ok($memd->prepend("key3", "start-"), "prepended start- to key3");
+ ok($memd->get("key3", "start-base-end"), "key3 is base-end");
+}
# also test creating the object with a list rather than a hash-ref
my $mem2 = Cache::Memcached->new(
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=44692&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/t/03_stats.t (original)
+++ branches/upstream/libcache-memcached-perl/current/t/03_stats.t Wed Sep 23 23:13:06 2009
@@ -16,7 +16,7 @@
/;
if ($msock) {
- plan tests => 24 + scalar(@misc_stats_keys);
+ plan tests => 16 + scalar(@misc_stats_keys);
} else {
plan skip_all => "No memcached instance running at $testaddr\n";
exit 0;
@@ -41,38 +41,3 @@
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');
Added: branches/upstream/libcache-memcached-perl/current/t/06_utf8_key.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcache-memcached-perl/current/t/06_utf8_key.t?rev=44692&op=file
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/t/06_utf8_key.t (added)
+++ branches/upstream/libcache-memcached-perl/current/t/06_utf8_key.t Wed Sep 23 23:13:06 2009
@@ -1,0 +1,26 @@
+#!/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 => 2;
+} else {
+ plan skip_all => "No memcached instance running at $testaddr\n";
+ exit 0;
+}
+
+my $memd = Cache::Memcached->new({
+ servers => [ $testaddr ],
+});
+
+use utf8;
+my $key = "Ãâ";
+
+ok($memd->set($key, "val1"), "set key1 as val1");
+is($memd->get($key), "val1", "get key1 is val1");
Modified: 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=44692&op=diff
==============================================================================
--- branches/upstream/libcache-memcached-perl/current/t/100_flush_bug.t (original)
+++ branches/upstream/libcache-memcached-perl/current/t/100_flush_bug.t Wed Sep 23 23:13:06 2009
@@ -5,11 +5,12 @@
use Cache::Memcached;
use IO::Socket::INET;
-my $testaddr = "127.0.0.1:11311";
+my $port = 11311;
+my $testaddr = "127.0.0.1:$port";
my $sock = IO::Socket::INET->new(
LocalAddr => $testaddr,
Proto => 'tcp',
- ReusAddr => 1,
+ ReuseAddr => 1,
);
my @res = (
@@ -30,15 +31,15 @@
}
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,
+ LocalAddr => $testaddr,
+ Proto => 'tcp',
+ ReuseAddr => 1,
+ Listen => 1,
) or die "cannot open $testaddr: $!";
my $csock = $sock->accept();
while (defined (my $buf = <$csock>)) {
@@ -50,6 +51,9 @@
exit 0;
}
+# give the forked server a chance to startup
+sleep 1;
+
my $memd = Cache::Memcached->new({ servers => [ $testaddr ] });
for (@res) {
More information about the Pkg-perl-cvs-commits
mailing list