1#!/usr/bin/perl
2
3use strict;
4use warnings;
5use Test::More tests => 3312;
6use FindBin qw($Bin);
7use lib "$Bin/lib";
8use MemcachedTest;
9
10my $server = new_memcached();
11ok($server, "started the server");
12
13# Based almost 100% off testClient.py which is:
14# Copyright (c) 2007  Dustin Sallings <dustin@spy.net>
15
16# Command constants
17use constant CMD_GET        => 0x00;
18use constant CMD_SET        => 0x01;
19use constant CMD_ADD        => 0x02;
20use constant CMD_REPLACE    => 0x03;
21use constant CMD_DELETE     => 0x04;
22use constant CMD_INCR       => 0x05;
23use constant CMD_DECR       => 0x06;
24use constant CMD_QUIT       => 0x07;
25use constant CMD_FLUSH      => 0x08;
26use constant CMD_GETQ       => 0x09;
27use constant CMD_NOOP       => 0x0A;
28use constant CMD_VERSION    => 0x0B;
29use constant CMD_GETK       => 0x0C;
30use constant CMD_GETKQ      => 0x0D;
31use constant CMD_APPEND     => 0x0E;
32use constant CMD_PREPEND    => 0x0F;
33use constant CMD_STAT       => 0x10;
34use constant CMD_SETQ       => 0x11;
35use constant CMD_ADDQ       => 0x12;
36use constant CMD_REPLACEQ   => 0x13;
37use constant CMD_DELETEQ    => 0x14;
38use constant CMD_INCREMENTQ => 0x15;
39use constant CMD_DECREMENTQ => 0x16;
40use constant CMD_QUITQ      => 0x17;
41use constant CMD_FLUSHQ     => 0x18;
42use constant CMD_APPENDQ    => 0x19;
43use constant CMD_PREPENDQ   => 0x1A;
44
45# REQ and RES formats are divided even though they currently share
46# the same format, since they _could_ differ in the future.
47use constant REQ_PKT_FMT      => "CCnCCnNNNN";
48use constant RES_PKT_FMT      => "CCnCCnNNNN";
49use constant INCRDECR_PKT_FMT => "NNNNN";
50use constant MIN_RECV_BYTES   => length(pack(RES_PKT_FMT));
51use constant REQ_MAGIC        => 0x80;
52use constant RES_MAGIC        => 0x81;
53
54my $mc = MC::Client->new;
55
56# Let's turn on detail stats for all this stuff
57
58$mc->stats('detail on');
59
60my $check = sub {
61    my ($key, $orig_flags, $orig_val) = @_;
62    my ($flags, $val, $cas) = $mc->get($key);
63    is($flags, $orig_flags, "Flags is set properly");
64    ok($val eq $orig_val || $val == $orig_val, $val . " = " . $orig_val);
65};
66
67my $set = sub {
68    my ($key, $exp, $orig_flags, $orig_value) = @_;
69    $mc->set($key, $orig_value, $orig_flags, $exp);
70    $check->($key, $orig_flags, $orig_value);
71};
72
73my $empty = sub {
74    my $key = shift;
75    my $rv =()= eval { $mc->get($key) };
76    is($rv, 0, "Didn't get a result from get");
77    ok($@->not_found, "We got a not found error when we expected one");
78};
79
80my $delete = sub {
81    my ($key, $when) = @_;
82    $mc->delete($key, $when);
83    $empty->($key);
84};
85
86# diag "Test Version";
87my $v = $mc->version;
88ok(defined $v && length($v), "Proper version: $v");
89
90# Bug 71
91{
92    my %stats1 = $mc->stats('');
93    $mc->flush;
94    my %stats2 = $mc->stats('');
95
96    is($stats2{'cmd_flush'}, $stats1{'cmd_flush'} + 1,
97       "Stats not updated on a binary flush");
98}
99
100# diag "Flushing...";
101$mc->flush;
102
103# diag "Noop";
104$mc->noop;
105
106# diag "Simple set/get";
107$set->('x', 5, 19, "somevalue");
108
109# diag "Delete";
110$delete->('x');
111
112# diag "Flush";
113$set->('x', 5, 19, "somevaluex");
114$set->('y', 5, 17, "somevaluey");
115$mc->flush;
116$empty->('x');
117$empty->('y');
118
119{
120    # diag "Add";
121    $empty->('i');
122    $mc->add('i', 'ex', 5, 10);
123    $check->('i', 5, "ex");
124
125    my $rv =()= eval { $mc->add('i', "ex2", 10, 5) };
126    is($rv, 0, "Add didn't return anything");
127    ok($@->exists, "Expected exists error received");
128    $check->('i', 5, "ex");
129}
130
131{
132    # diag "Too big.";
133    $empty->('toobig');
134    $mc->set('toobig', 'not too big', 10, 10);
135    eval {
136        my $bigval = ("x" x (1024*1024)) . "x";
137        $mc->set('toobig', $bigval, 10, 10);
138    };
139    ok($@->too_big, "Was too big");
140    $empty->('toobig');
141}
142
143{
144    # diag "Replace";
145    $empty->('j');
146
147    my $rv =()= eval { $mc->replace('j', "ex", 19, 5) };
148    is($rv, 0, "Replace didn't return anything");
149    ok($@->not_found, "Expected not_found error received");
150    $empty->('j');
151    $mc->add('j', "ex2", 14, 5);
152    $check->('j', 14, "ex2");
153    $mc->replace('j', "ex3", 24, 5);
154    $check->('j', 24, "ex3");
155}
156
157{
158    # diag "MultiGet";
159    $mc->add('xx', "ex", 1, 5);
160    $mc->add('wye', "why", 2, 5);
161    my $rv = $mc->get_multi(qw(xx wye zed));
162
163    # CAS is returned with all gets.
164    $rv->{xx}->[2]  = 0;
165    $rv->{wye}->[2] = 0;
166    is_deeply($rv->{xx}, [1, 'ex', 0], "X is correct");
167    is_deeply($rv->{wye}, [2, 'why', 0], "Y is correct");
168    is(keys(%$rv), 2, "Got only two answers like we expect");
169}
170
171# diag "Test increment";
172$mc->flush;
173is($mc->incr("x"), 0, "First incr call is zero");
174is($mc->incr("x"), 1, "Second incr call is one");
175is($mc->incr("x", 211), 212, "Adding 211 gives you 212");
176is($mc->incr("x", 2**33), 8589934804, "Blast the 32bit border");
177
178# diag "Issue 48 - incrementing plain text.";
179{
180    $mc->set("issue48", "text", 0, 0);
181    my $rv =()= eval { $mc->incr('issue48'); };
182    ok($@ && $@->delta_badval, "Expected invalid value when incrementing text.");
183    $check->('issue48', 0, "text");
184
185    $rv =()= eval { $mc->decr('issue48'); };
186    ok($@ && $@->delta_badval, "Expected invalid value when decrementing text.");
187    $check->('issue48', 0, "text");
188}
189
190
191# diag "Test decrement";
192$mc->flush;
193is($mc->incr("x", undef, 5), 5, "Initial value");
194is($mc->decr("x"), 4, "Decrease by one");
195is($mc->decr("x", 211), 0, "Floor is zero");
196
197{
198    # diag "bug21";
199    $mc->add("bug21", "9223372036854775807", 0, 0);
200    is($mc->incr("bug21"), 9223372036854775808, "First incr for bug21.");
201    is($mc->incr("bug21"), 9223372036854775809, "Second incr for bug21.");
202    is($mc->decr("bug21"), 9223372036854775808, "Decr for bug21.");
203}
204
205{
206    # diag "CAS";
207    $mc->flush;
208
209    {
210        my $rv =()= eval { $mc->set("x", "bad value", 19, 5, 0x7FFFFFF) };
211        is($rv, 0, "Empty return on expected failure");
212        ok($@->not_found, "Error was 'not found' as expected");
213    }
214
215    $mc->add("x", "original value", 5, 19);
216
217    my ($flags, $val, $i) = $mc->get("x");
218    is($val, "original value", "->gets returned proper value");
219
220    {
221        my $rv =()= eval { $mc->set("x", "broken value", 19, 5, $i+1) };
222        is($rv, 0, "Empty return on expected failure (1)");
223        ok($@->exists, "Expected error state of 'exists' (1)");
224    }
225
226    $mc->set("x", "new value", 19, 5, $i);
227
228    my ($newflags, $newval, $newi) = $mc->get("x");
229    is($newval, "new value", "CAS properly overwrote value");
230
231    {
232        my $rv =()= eval { $mc->set("x", "replay value", 19, 5,  $i) };
233        is($rv, 0, "Empty return on expected failure (2)");
234        ok($@->exists, "Expected error state of 'exists' (2)");
235    }
236}
237
238# diag "Silent set.";
239$mc->silent_mutation(::CMD_SETQ, 'silentset', 'silentsetval');
240
241# diag "Silent add.";
242$mc->silent_mutation(::CMD_ADDQ, 'silentadd', 'silentaddval');
243
244# diag "Silent replace.";
245{
246    my $key = "silentreplace";
247    my $extra = pack "NN", 829, 0;
248    $empty->($key);
249    # $mc->send_silent(::CMD_REPLACEQ, $key, 'somevalue', 7278552, $extra, 0);
250    # $empty->($key);
251
252    $mc->add($key, "xval", 831, 0);
253    $check->($key, 831, 'xval');
254
255    $mc->send_silent(::CMD_REPLACEQ, $key, 'somevalue', 7278552, $extra, 0);
256    $check->($key, 829, 'somevalue');
257}
258
259# diag "Silent delete";
260{
261    my $key = "silentdelete";
262    $empty->($key);
263    $mc->set($key, "some val", 19, 0);
264    $mc->send_silent(::CMD_DELETEQ, $key, '', 772);
265    $empty->($key);
266}
267
268# diag "Silent increment";
269{
270    my $key = "silentincr";
271    my $opaque = 98428747;
272    $empty->($key);
273    $mc->silent_incrdecr(::CMD_INCREMENTQ, $key, 0, 0, 0);
274    is($mc->incr($key, 0), 0, "First call is 0");
275
276    $mc->silent_incrdecr(::CMD_INCREMENTQ, $key, 8, 0, 0);
277    is($mc->incr($key, 0), 8);
278}
279
280# diag "Silent decrement";
281{
282    my $key = "silentdecr";
283    my $opaque = 98428147;
284    $empty->($key);
285    $mc->silent_incrdecr(::CMD_DECREMENTQ, $key, 0, 185, 0);
286    is($mc->incr($key, 0), 185);
287
288    $mc->silent_incrdecr(::CMD_DECREMENTQ, $key, 8, 0, 0);
289    is($mc->incr($key, 0), 177);
290}
291
292# diag "Silent flush";
293{
294    my %stats1 = $mc->stats('');
295
296    $set->('x', 5, 19, "somevaluex");
297    $set->('y', 5, 17, "somevaluey");
298    $mc->send_silent(::CMD_FLUSHQ, '', '', 2775256);
299    $empty->('x');
300    $empty->('y');
301
302    my %stats2 = $mc->stats('');
303    is($stats2{'cmd_flush'}, $stats1{'cmd_flush'} + 1,
304       "Stats not updated on a binary quiet flush");
305}
306
307# diag "Append";
308{
309    my $key = "appendkey";
310    my $value = "some value";
311    $set->($key, 8, 19, $value);
312    $mc->_append_prepend(::CMD_APPEND, $key, " more");
313    $check->($key, 19, $value . " more");
314}
315
316# diag "Prepend";
317{
318    my $key = "prependkey";
319    my $value = "some value";
320    $set->($key, 8, 19, $value);
321    $mc->_append_prepend(::CMD_PREPEND, $key, "prefixed ");
322    $check->($key, 19, "prefixed " . $value);
323}
324
325# diag "Silent append";
326{
327    my $key = "appendqkey";
328    my $value = "some value";
329    $set->($key, 8, 19, $value);
330    $mc->send_silent(::CMD_APPENDQ, $key, " more", 7284492);
331    $check->($key, 19, $value . " more");
332}
333
334# diag "Silent prepend";
335{
336    my $key = "prependqkey";
337    my $value = "some value";
338    $set->($key, 8, 19, $value);
339    $mc->send_silent(::CMD_PREPENDQ, $key, "prefixed ", 7284492);
340    $check->($key, 19, "prefixed " . $value);
341}
342
343# diag "Leaky binary get test.";
344# # http://code.google.com/p/memcached/issues/detail?id=16
345{
346    # Get a new socket so we can speak text to it.
347    my $sock = $server->new_sock;
348    my $max = 1024 * 1024;
349    my $big = "a big value that's > .5M and < 1M. ";
350    while (length($big) * 2 < $max) {
351        $big = $big . $big;
352    }
353    my $biglen = length($big);
354
355    for(1..100) {
356        my $key = "some_key_$_";
357        # print STDERR "Key is $key\n";
358        # print $sock "set $key 0 0 $vallen\r\n$value\r\n";
359        print $sock "set $key 0 0 $biglen\r\n$big\r\n";
360        is(scalar <$sock>, "STORED\r\n", "stored big");
361        my ($f, $v, $c) = $mc->get($key);
362    }
363}
364
365# diag "Test stats settings."
366{
367    my %stats = $mc->stats('settings');
368
369    is(1024, $stats{'maxconns'});
370    is('NULL', $stats{'domain_socket'});
371    is('on', $stats{'evictions'});
372    is('yes', $stats{'cas_enabled'});
373}
374
375# diag "Test protocol boundary overruns";
376{
377    use List::Util qw[min];
378    # Attempting some protocol overruns by toying around with the edge
379    # of the data buffer at a few different sizes.  This assumes the
380    # boundary is at or around 2048 bytes.
381    for (my $i = 1900; $i < 2100; $i++) {
382        my $k = "test_key_$i";
383        my $v = 'x' x $i;
384        # diag "Trying $i $k";
385        my $extra = pack "NN", 82, 0;
386        my $data = $mc->build_command(::CMD_SETQ, $k, $v, 0, $extra, 0);
387        $data .= $mc->build_command(::CMD_SETQ, "alt_$k", "blah", 0, $extra, 0);
388        if (length($data) > 2024) {
389            for (my $j = 2024; $j < min(2096, length($data)); $j++) {
390                $mc->{socket}->send(substr($data, 0, $j));
391                $mc->flush_socket;
392                sleep(0.001);
393                $mc->{socket}->send(substr($data, $j));
394                $mc->flush_socket;
395            }
396        } else {
397            $mc->{socket}->send($data);
398        }
399        $mc->flush_socket;
400        $check->($k, 82, $v);
401        $check->("alt_$k", 82, "blah");
402    }
403}
404
405# Along with the assertion added to the code to verify we're staying
406# within bounds when we do a stats detail dump (detail turned on at
407# the top).
408my %stats = $mc->stats('detail dump');
409
410# ######################################################################
411# Test ends around here.
412# ######################################################################
413
414package MC::Client;
415
416use strict;
417use warnings;
418use fields qw(socket);
419use IO::Socket::INET;
420
421sub new {
422    my $self = shift;
423    my $sock = $server->sock;
424    $self = fields::new($self);
425    $self->{socket} = $sock;
426    return $self;
427}
428
429sub build_command {
430    my $self = shift;
431    die "Not enough args to send_command" unless @_ >= 4;
432    my ($cmd, $key, $val, $opaque, $extra_header, $cas) = @_;
433
434    $extra_header = '' unless defined $extra_header;
435    my $keylen    = length($key);
436    my $vallen    = length($val);
437    my $extralen  = length($extra_header);
438    my $datatype  = 0;  # field for future use
439    my $reserved  = 0;  # field for future use
440    my $totallen  = $keylen + $vallen + $extralen;
441    my $ident_hi  = 0;
442    my $ident_lo  = 0;
443
444    if ($cas) {
445        $ident_hi = int($cas / 2 ** 32);
446        $ident_lo = int($cas % 2 ** 32);
447    }
448
449    my $msg = pack(::REQ_PKT_FMT, ::REQ_MAGIC, $cmd, $keylen, $extralen,
450                   $datatype, $reserved, $totallen, $opaque, $ident_hi,
451                   $ident_lo);
452    my $full_msg = $msg . $extra_header . $key . $val;
453    return $full_msg;
454}
455
456sub send_command {
457    my $self = shift;
458    die "Not enough args to send_command" unless @_ >= 4;
459    my ($cmd, $key, $val, $opaque, $extra_header, $cas) = @_;
460
461    my $full_msg = $self->build_command($cmd, $key, $val, $opaque, $extra_header, $cas);
462
463    my $sent = $self->{socket}->send($full_msg);
464    die("Send failed:  $!") unless $sent;
465    if($sent != length($full_msg)) {
466        die("only sent $sent of " . length($full_msg) . " bytes");
467    }
468}
469
470sub flush_socket {
471    my $self = shift;
472    $self->{socket}->flush;
473}
474
475# Send a silent command and ensure it doesn't respond.
476sub send_silent {
477    my $self = shift;
478    die "Not enough args to send_silent" unless @_ >= 4;
479    my ($cmd, $key, $val, $opaque, $extra_header, $cas) = @_;
480
481    $self->send_command($cmd, $key, $val, $opaque, $extra_header, $cas);
482    $self->send_command(::CMD_NOOP, '', '', $opaque + 1);
483
484    my ($ropaque, $data) = $self->_handle_single_response;
485    Test::More::is($ropaque, $opaque + 1);
486}
487
488sub silent_mutation {
489    my $self = shift;
490    my ($cmd, $key, $value) = @_;
491
492    $empty->($key);
493    my $extra = pack "NN", 82, 0;
494    $mc->send_silent($cmd, $key, $value, 7278552, $extra, 0);
495    $check->($key, 82, $value);
496}
497
498sub _handle_single_response {
499    my $self = shift;
500    my $myopaque = shift;
501
502    $self->{socket}->recv(my $response, ::MIN_RECV_BYTES);
503    Test::More::is(length($response), ::MIN_RECV_BYTES, "Expected read length");
504
505    my ($magic, $cmd, $keylen, $extralen, $datatype, $status, $remaining,
506        $opaque, $ident_hi, $ident_lo) = unpack(::RES_PKT_FMT, $response);
507    Test::More::is($magic, ::RES_MAGIC, "Got proper response magic");
508
509    return ($opaque, '', '', 0) if($remaining == 0);
510
511    # fetch the value
512    my $rv="";
513    while($remaining - length($rv) > 0) {
514        $self->{socket}->recv(my $buf, $remaining - length($rv));
515        $rv .= $buf;
516    }
517    if(length($rv) != $remaining) {
518        my $found = length($rv);
519        die("Expected $remaining bytes, got $found");
520    }
521
522    if (defined $myopaque) {
523        Test::More::is($opaque, $myopaque, "Expected opaque");
524    } else {
525        Test::More::pass("Implicit pass since myopaque is undefined");
526    }
527
528    my $cas = ($ident_hi * 2 ** 32) + $ident_lo;
529
530    if ($status) {
531        die MC::Error->new($status, $rv);
532    }
533
534    return ($opaque, $rv, $cas, $keylen);
535}
536
537sub _do_command {
538    my $self = shift;
539    die unless @_ >= 3;
540    my ($cmd, $key, $val, $extra_header, $cas) = @_;
541
542    $extra_header = '' unless defined $extra_header;
543    my $opaque = int(rand(2**32));
544    $self->send_command($cmd, $key, $val, $opaque, $extra_header, $cas);
545    my (undef, $rv, $rcas) = $self->_handle_single_response($opaque);
546    return ($rv, $rcas);
547}
548
549sub _incrdecr_header {
550    my $self = shift;
551    my ($amt, $init, $exp) = @_;
552
553    my $amt_hi = int($amt / 2 ** 32);
554    my $amt_lo = int($amt % 2 ** 32);
555
556    my $init_hi = int($init / 2 ** 32);
557    my $init_lo = int($init % 2 ** 32);
558
559    my $extra_header = pack(::INCRDECR_PKT_FMT, $amt_hi, $amt_lo, $init_hi,
560                            $init_lo, $exp);
561
562    return $extra_header;
563}
564
565sub _incrdecr {
566    my $self = shift;
567    my ($cmd, $key, $amt, $init, $exp) = @_;
568
569    my ($data, undef) = $self->_do_command($cmd, $key, '',
570                                           $self->_incrdecr_header($amt, $init, $exp));
571
572    my $header = substr $data, 0, 8, '';
573    my ($resp_hi, $resp_lo) = unpack "NN", $header;
574    my $resp = ($resp_hi * 2 ** 32) + $resp_lo;
575
576    return $resp;
577}
578
579sub silent_incrdecr {
580    my $self = shift;
581    my ($cmd, $key, $amt, $init, $exp) = @_;
582    my $opaque = 8275753;
583
584    $mc->send_silent($cmd, $key, '', $opaque,
585                     $mc->_incrdecr_header($amt, $init, $exp));
586}
587
588sub stats {
589    my $self = shift;
590    my $key  = shift;
591    my $cas = 0;
592    my $opaque = int(rand(2**32));
593    $self->send_command(::CMD_STAT, $key, '', $opaque, '', $cas);
594
595    my %rv = ();
596    my $found_key = '';
597    my $found_val = '';
598    do {
599        my ($op, $data, $cas, $keylen) = $self->_handle_single_response($opaque);
600        if($keylen > 0) {
601            $found_key = substr($data, 0, $keylen);
602            $found_val = substr($data, $keylen);
603            $rv{$found_key} = $found_val;
604        } else {
605            $found_key = '';
606        }
607    } while($found_key ne '');
608    return %rv;
609}
610
611sub get {
612    my $self = shift;
613    my $key  = shift;
614    my ($rv, $cas) = $self->_do_command(::CMD_GET, $key, '', '');
615
616    my $header = substr $rv, 0, 4, '';
617    my $flags  = unpack("N", $header);
618
619    return ($flags, $rv, $cas);
620}
621
622sub get_multi {
623    my $self = shift;
624    my @keys = @_;
625
626    for (my $i = 0; $i < @keys; $i++) {
627        $self->send_command(::CMD_GETQ, $keys[$i], '', $i, '', 0);
628    }
629
630    my $terminal = @keys + 10;
631    $self->send_command(::CMD_NOOP, '', '', $terminal);
632
633    my %return;
634    while (1) {
635        my ($opaque, $data) = $self->_handle_single_response;
636        last if $opaque == $terminal;
637
638        my $header = substr $data, 0, 4, '';
639        my $flags  = unpack("N", $header);
640
641        $return{$keys[$opaque]} = [$flags, $data];
642    }
643
644    return %return if wantarray;
645    return \%return;
646}
647
648sub version {
649    my $self = shift;
650    return $self->_do_command(::CMD_VERSION, '', '');
651}
652
653sub flush {
654    my $self = shift;
655    return $self->_do_command(::CMD_FLUSH, '', '');
656}
657
658sub add {
659    my $self = shift;
660    my ($key, $val, $flags, $expire) = @_;
661    my $extra_header = pack "NN", $flags, $expire;
662    my $cas = 0;
663    return $self->_do_command(::CMD_ADD, $key, $val, $extra_header, $cas);
664}
665
666sub set {
667    my $self = shift;
668    my ($key, $val, $flags, $expire, $cas) = @_;
669    my $extra_header = pack "NN", $flags, $expire;
670    return $self->_do_command(::CMD_SET, $key, $val, $extra_header, $cas);
671}
672
673sub _append_prepend {
674    my $self = shift;
675    my ($cmd, $key, $val, $cas) = @_;
676    return $self->_do_command($cmd, $key, $val, '', $cas);
677}
678
679sub replace {
680    my $self = shift;
681    my ($key, $val, $flags, $expire) = @_;
682    my $extra_header = pack "NN", $flags, $expire;
683    my $cas = 0;
684    return $self->_do_command(::CMD_REPLACE, $key, $val, $extra_header, $cas);
685}
686
687sub delete {
688    my $self = shift;
689    my ($key) = @_;
690    return $self->_do_command(::CMD_DELETE, $key, '');
691}
692
693sub incr {
694    my $self = shift;
695    my ($key, $amt, $init, $exp) = @_;
696    $amt = 1 unless defined $amt;
697    $init = 0 unless defined $init;
698    $exp = 0 unless defined $exp;
699
700    return $self->_incrdecr(::CMD_INCR, $key, $amt, $init, $exp);
701}
702
703sub decr {
704    my $self = shift;
705    my ($key, $amt, $init, $exp) = @_;
706    $amt = 1 unless defined $amt;
707    $init = 0 unless defined $init;
708    $exp = 0 unless defined $exp;
709
710    return $self->_incrdecr(::CMD_DECR, $key, $amt, $init, $exp);
711}
712
713sub noop {
714    my $self = shift;
715    return $self->_do_command(::CMD_NOOP, '', '');
716}
717
718package MC::Error;
719
720use strict;
721use warnings;
722
723use constant ERR_UNKNOWN_CMD  => 0x81;
724use constant ERR_NOT_FOUND    => 0x1;
725use constant ERR_EXISTS       => 0x2;
726use constant ERR_TOO_BIG      => 0x3;
727use constant ERR_EINVAL       => 0x4;
728use constant ERR_NOT_STORED   => 0x5;
729use constant ERR_DELTA_BADVAL => 0x6;
730
731use overload '""' => sub {
732    my $self = shift;
733    return "Memcache Error ($self->[0]): $self->[1]";
734};
735
736sub new {
737    my $class = shift;
738    my $error = [@_];
739    my $self = bless $error, (ref $class || $class);
740
741    return $self;
742}
743
744sub not_found {
745    my $self = shift;
746    return $self->[0] == ERR_NOT_FOUND;
747}
748
749sub exists {
750    my $self = shift;
751    return $self->[0] == ERR_EXISTS;
752}
753
754sub too_big {
755    my $self = shift;
756    return $self->[0] == ERR_TOO_BIG;
757}
758
759sub delta_badval {
760    my $self = shift;
761    return $self->[0] == ERR_DELTA_BADVAL;
762}
763
764# vim: filetype=perl
765
766