diff t/lib/MemcachedTest.pm~ @ 0:30782bb1fc04 MEMCACHED_1_2_3

memcached-1.2.3
author Maxim Dounin <mdounin@mdounin.ru>
date Sun, 23 Sep 2007 03:58:34 +0400
parents
children
line wrap: on
line diff
new file mode 100644
--- /dev/null
+++ b/t/lib/MemcachedTest.pm~
@@ -0,0 +1,153 @@
+package MemcachedTest;
+use strict;
+use IO::Socket::INET;
+use Exporter 'import';
+use FindBin qw($Bin);
+use Carp qw(croak);
+use vars qw(@EXPORT);
+
+@EXPORT = qw(new_memcached sleep mem_get_is mem_stats free_port);
+
+sub sleep {
+    my $n = shift;
+    select undef, undef, undef, $n;
+}
+
+sub mem_stats {
+    my ($sock, $type) = @_;
+    $type = $type ? " $type" : "";
+    print $sock "stats$type\r\n";
+    my $stats = {};
+    while (<$sock>) {
+        last if /^(\.|END)/;
+        /^STAT (\S+) (\d+)/;
+        #print " slabs: $_";
+        $stats->{$1} = $2;
+    }
+    return $stats;
+}
+
+sub mem_get_is {
+    # works on single-line values only.  no newlines in value.
+    my ($sock_opts, $key, $val, $msg) = @_;
+    my $opts = ref $sock_opts eq "HASH" ? $sock_opts : {};
+    my $sock = ref $sock_opts eq "HASH" ? $opts->{sock} : $sock_opts;
+
+    my $expect_flags = $opts->{flags} || 0;
+    my $dval = defined $val ? "'$val'" : "<undef>";
+    $msg ||= "$key == $dval";
+
+    print $sock "get $key\r\n";
+    if (! defined $val) {
+        my $line = scalar <$sock>;
+        if ($line =~ /^VALUE/) {
+            $line .= scalar(<$sock>) . scalar(<$sock>);
+        }
+        Test::More::is($line, "END\r\n", $msg);
+    } else {
+        my $len = length($val);
+        my $body = scalar(<$sock>);
+        my $expected = "VALUE $key $expect_flags $len\r\n$val\r\nEND\r\n";
+        if (!$body || $body =~ /^END/) {
+            Test::More::is($body, $expected, $msg);
+            return;
+        }
+        $body .= scalar(<$sock>) . scalar(<$sock>);
+        Test::More::is($body, $expected, $msg);
+    }
+}
+
+sub free_port {
+    my $type = shift || "tcp";
+    my $sock;
+    my $port;
+    while (!$sock) {
+        $port = int(rand(20000)) + 30000;
+        $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1',
+                                      LocalPort => $port,
+                                      Proto     => $type,
+                                      ReuseAddr => 1);
+    }
+    return $port;
+}
+
+sub supports_udp {
+    my $output = `$Bin/../memcached-debug -h`;
+    return 0 if $output =~ /^memcached 1\.1\./;
+    return 1;
+}
+
+sub new_memcached {
+    my $args = shift || "";
+    my $port = free_port();
+    my $udpport = free_port("udp");
+    $args .= " -p $port";
+    if (supports_udp()) {
+        $args .= " -U $udpport";
+    }
+    if ($< == 0) {
+        $args .= " -u root";
+    }
+    my $childpid = fork();
+
+    my $exe = "$Bin/../memcached-debug";
+    croak("memcached binary doesn't exist.  Haven't run 'make' ?\n") unless -e $exe;
+    croak("memcached binary not executable\n") unless -x _;
+
+    unless ($childpid) {
+        exec "$exe $args";
+        exit; # never gets here.
+    }
+
+    for (1..20) {
+        my $conn = IO::Socket::INET->new(PeerAddr => "127.0.0.1:$port");
+        if ($conn) {
+            return Memcached::Handle->new(pid  => $childpid,
+                                          conn => $conn,
+                                          udpport => $udpport,
+                                          port => $port);
+        }
+        select undef, undef, undef, 0.10;
+    }
+    croak("Failed to startup/connect to memcached server.");
+
+}
+
+############################################################################
+package Memcached::Handle;
+sub new {
+    my ($class, %params) = @_;
+    return bless \%params, $class;
+}
+
+sub DESTROY {
+    my $self = shift;
+    kill 9, $self->{pid};
+}
+
+sub port { $_[0]{port} }
+sub udpport { $_[0]{udpport} }
+
+sub sock {
+    my $self = shift;
+    return $self->{conn} if $self->{conn} && getpeername($self->{conn});
+    return $self->new_sock;
+}
+
+sub new_sock {
+    my $self = shift;
+    return IO::Socket::INET->new(PeerAddr => "127.0.0.1:$self->{port}");
+}
+
+sub new_udp_sock {
+    my $self = shift;
+    return IO::Socket::INET->new(PeerAddr => '127.0.0.1',
+                                 PeerPort => $self->{udpport},
+                                 Proto    => 'udp',
+                                 LocalAddr => '127.0.0.1',
+                                 LocalPort => MemcachedTest::free_port('udp'),
+                                 );
+
+}
+
+1;