|
0
|
1 package MemcachedTest;
|
|
|
2 use strict;
|
|
|
3 use IO::Socket::INET;
|
|
|
4 use Exporter 'import';
|
|
|
5 use FindBin qw($Bin);
|
|
|
6 use Carp qw(croak);
|
|
|
7 use vars qw(@EXPORT);
|
|
|
8
|
|
|
9 @EXPORT = qw(new_memcached sleep mem_get_is mem_stats free_port);
|
|
|
10
|
|
|
11 sub sleep {
|
|
|
12 my $n = shift;
|
|
|
13 select undef, undef, undef, $n;
|
|
|
14 }
|
|
|
15
|
|
|
16 sub mem_stats {
|
|
|
17 my ($sock, $type) = @_;
|
|
|
18 $type = $type ? " $type" : "";
|
|
|
19 print $sock "stats$type\r\n";
|
|
|
20 my $stats = {};
|
|
|
21 while (<$sock>) {
|
|
|
22 last if /^(\.|END)/;
|
|
|
23 /^STAT (\S+) (\d+)/;
|
|
|
24 #print " slabs: $_";
|
|
|
25 $stats->{$1} = $2;
|
|
|
26 }
|
|
|
27 return $stats;
|
|
|
28 }
|
|
|
29
|
|
|
30 sub mem_get_is {
|
|
|
31 # works on single-line values only. no newlines in value.
|
|
|
32 my ($sock_opts, $key, $val, $msg) = @_;
|
|
|
33 my $opts = ref $sock_opts eq "HASH" ? $sock_opts : {};
|
|
|
34 my $sock = ref $sock_opts eq "HASH" ? $opts->{sock} : $sock_opts;
|
|
|
35
|
|
|
36 my $expect_flags = $opts->{flags} || 0;
|
|
|
37 my $dval = defined $val ? "'$val'" : "<undef>";
|
|
|
38 $msg ||= "$key == $dval";
|
|
|
39
|
|
|
40 print $sock "get $key\r\n";
|
|
|
41 if (! defined $val) {
|
|
|
42 my $line = scalar <$sock>;
|
|
|
43 if ($line =~ /^VALUE/) {
|
|
|
44 $line .= scalar(<$sock>) . scalar(<$sock>);
|
|
|
45 }
|
|
|
46 Test::More::is($line, "END\r\n", $msg);
|
|
|
47 } else {
|
|
|
48 my $len = length($val);
|
|
|
49 my $body = scalar(<$sock>);
|
|
|
50 my $expected = "VALUE $key $expect_flags $len\r\n$val\r\nEND\r\n";
|
|
|
51 if (!$body || $body =~ /^END/) {
|
|
|
52 Test::More::is($body, $expected, $msg);
|
|
|
53 return;
|
|
|
54 }
|
|
|
55 $body .= scalar(<$sock>) . scalar(<$sock>);
|
|
|
56 Test::More::is($body, $expected, $msg);
|
|
|
57 }
|
|
|
58 }
|
|
|
59
|
|
|
60 sub free_port {
|
|
|
61 my $type = shift || "tcp";
|
|
|
62 my $sock;
|
|
|
63 my $port;
|
|
|
64 while (!$sock) {
|
|
|
65 $port = int(rand(20000)) + 30000;
|
|
|
66 $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1',
|
|
|
67 LocalPort => $port,
|
|
|
68 Proto => $type,
|
|
|
69 ReuseAddr => 1);
|
|
|
70 }
|
|
|
71 return $port;
|
|
|
72 }
|
|
|
73
|
|
|
74 sub supports_udp {
|
|
|
75 my $output = `$Bin/../memcached-debug -h`;
|
|
|
76 return 0 if $output =~ /^memcached 1\.1\./;
|
|
|
77 return 1;
|
|
|
78 }
|
|
|
79
|
|
|
80 sub new_memcached {
|
|
|
81 my $args = shift || "";
|
|
|
82 my $port = free_port();
|
|
|
83 my $udpport = free_port("udp");
|
|
|
84 $args .= " -p $port";
|
|
|
85 if (supports_udp()) {
|
|
|
86 $args .= " -U $udpport";
|
|
|
87 }
|
|
|
88 if ($< == 0) {
|
|
|
89 $args .= " -u root";
|
|
|
90 }
|
|
|
91 my $childpid = fork();
|
|
|
92
|
|
|
93 my $exe = "$Bin/../memcached-debug";
|
|
|
94 croak("memcached binary doesn't exist. Haven't run 'make' ?\n") unless -e $exe;
|
|
|
95 croak("memcached binary not executable\n") unless -x _;
|
|
|
96
|
|
|
97 unless ($childpid) {
|
|
|
98 exec "$exe $args";
|
|
|
99 exit; # never gets here.
|
|
|
100 }
|
|
|
101
|
|
|
102 for (1..20) {
|
|
|
103 my $conn = IO::Socket::INET->new(PeerAddr => "127.0.0.1:$port");
|
|
|
104 if ($conn) {
|
|
|
105 return Memcached::Handle->new(pid => $childpid,
|
|
|
106 conn => $conn,
|
|
|
107 udpport => $udpport,
|
|
|
108 port => $port);
|
|
|
109 }
|
|
|
110 select undef, undef, undef, 0.10;
|
|
|
111 }
|
|
|
112 croak("Failed to startup/connect to memcached server.");
|
|
|
113
|
|
|
114 }
|
|
|
115
|
|
|
116 ############################################################################
|
|
|
117 package Memcached::Handle;
|
|
|
118 sub new {
|
|
|
119 my ($class, %params) = @_;
|
|
|
120 return bless \%params, $class;
|
|
|
121 }
|
|
|
122
|
|
|
123 sub DESTROY {
|
|
|
124 my $self = shift;
|
|
|
125 kill 9, $self->{pid};
|
|
|
126 }
|
|
|
127
|
|
|
128 sub port { $_[0]{port} }
|
|
|
129 sub udpport { $_[0]{udpport} }
|
|
|
130
|
|
|
131 sub sock {
|
|
|
132 my $self = shift;
|
|
|
133 return $self->{conn} if $self->{conn} && getpeername($self->{conn});
|
|
|
134 return $self->new_sock;
|
|
|
135 }
|
|
|
136
|
|
|
137 sub new_sock {
|
|
|
138 my $self = shift;
|
|
|
139 return IO::Socket::INET->new(PeerAddr => "127.0.0.1:$self->{port}");
|
|
|
140 }
|
|
|
141
|
|
|
142 sub new_udp_sock {
|
|
|
143 my $self = shift;
|
|
|
144 return IO::Socket::INET->new(PeerAddr => '127.0.0.1',
|
|
|
145 PeerPort => $self->{udpport},
|
|
|
146 Proto => 'udp',
|
|
|
147 LocalAddr => '127.0.0.1',
|
|
|
148 LocalPort => MemcachedTest::free_port('udp'),
|
|
|
149 );
|
|
|
150
|
|
|
151 }
|
|
|
152
|
|
|
153 1;
|
