xref: /memcached-1.4.29/t/lib/MemcachedTest.pm (revision 70079ca3) 
1package MemcachedTest;
2use strict;
3use IO::Socket::INET;
4use Exporter 'import';
5use FindBin qw($Bin);
6use Carp qw(croak);
7use vars qw(@EXPORT);
8
9@EXPORT = qw(new_memcached sleep mem_get_is mem_stats free_port);
10
11sub sleep {
12    my $n = shift;
13    select undef, undef, undef, $n;
14}
15
16sub 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
30sub 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
60sub 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
74sub new_memcached {
75    my $args = shift || "";
76    my $port = free_port();
77    my $udpport = free_port("udp");
78    $args .= " -p $port -U $udpport";
79    if ($< == 0) {
80        $args .= " -u root";
81    }
82    my $childpid = fork();
83
84    my $exe = "$Bin/../memcached-debug";
85    croak("memcached binary doesn't exist.  Haven't run 'make' ?\n") unless -e $exe;
86    croak("memcached binary not executable\n") unless -x _;
87
88    unless ($childpid) {
89        exec "$exe $args";
90        exit; # never gets here.
91    }
92
93    for (1..20) {
94        my $conn = IO::Socket::INET->new(PeerAddr => "127.0.0.1:$port");
95        if ($conn) {
96            return Memcached::Handle->new(pid  => $childpid,
97                                          conn => $conn,
98                                          udpport => $udpport,
99                                          port => $port);
100        }
101        select undef, undef, undef, 0.10;
102    }
103    croak("Failed to startup/connect to memcached server.");
104
105}
106
107############################################################################
108package Memcached::Handle;
109sub new {
110    my ($class, %params) = @_;
111    return bless \%params, $class;
112}
113
114sub DESTROY {
115    my $self = shift;
116    kill 9, $self->{pid};
117}
118
119sub port { $_[0]{port} }
120sub udpport { $_[0]{udpport} }
121
122sub sock {
123    my $self = shift;
124    return $self->{conn} if $self->{conn} && getpeername($self->{conn});
125    return $self->new_sock;
126}
127
128sub new_sock {
129    my $self = shift;
130    return IO::Socket::INET->new(PeerAddr => "127.0.0.1:$self->{port}");
131}
132
133sub new_udp_sock {
134    my $self = shift;
135    return IO::Socket::INET->new(PeerAddr => '127.0.0.1',
136                                 PeerPort => $self->{udpport},
137                                 Proto    => 'udp',
138                                 LocalAddr => '127.0.0.1',
139                                 LocalPort => MemcachedTest::free_port('udp'),
140                                 );
141
142}
143
1441;
145