Mercurial > hg > memcached
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,176 @@ +package MemcachedTest; +use strict; +use IO::Socket::INET; +use IO::Socket::UNIX; +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. + } + + # unix domain sockets + if ($args =~ /-s (\S+)/) { + sleep 1; + my $filename = $1; + my $conn = IO::Socket::UNIX->new(Peer => $filename) || + croak("Failed to connect to unix domain socket: $! '$filename'"); + + return Memcached::Handle->new(pid => $childpid, + conn => $conn, + domainsocket => $filename, + port => $port); + } + + # try to connect / find open port, only if we're not using unix domain + # sockets + + 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; + + if ($self->{conn} && ($self->{domainsocket} || getpeername($self->{conn}))) { + return $self->{conn}; + } + return $self->new_sock; +} + +sub new_sock { + my $self = shift; + if ($self->{domainsocket}) { + return IO::Socket::UNIX->new(Peer => $self->{domainsocket}); + } else { + 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;