git.m6w6.name Git - awesomized/libmemcached/blob - memcached/t/multiversioning.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use Test::More tests => 13;
   5 use FindBin qw($Bin);
   6 use lib "$Bin/lib";
   7 use MemcachedTest;
   8
   9 my $server = new_memcached();
  10 my $sock  = $server->sock;
  11 my $sock2 = $server->new_sock;
  12
  13 ok($sock != $sock2, "have two different connections open");
  14
  15 # set large value
  16 my $size   = 256 * 1024;  # 256 kB
  17 my $bigval = "0123456789abcdef" x ($size / 16);
  18 $bigval =~ s/^0/\[/; $bigval =~ s/f$/\]/;
  19 my $bigval2 = uc($bigval);
  20
  21 print $sock "set big 0 0 $size\r\n$bigval\r\n";
  22 is(scalar <$sock>, "STORED\r\n", "stored foo");
  23 mem_get_is($sock, "big", $bigval, "big value got correctly");
  24
  25 print $sock "get big\r\n";
  26 my $buf;
  27 is(read($sock, $buf, $size / 2), $size / 2, "read half the answer back");
  28 like($buf, qr/VALUE big/, "buf has big value header in it");
  29 like($buf, qr/abcdef/, "buf has some data in it");
  30 unlike($buf, qr/abcde\]/, "buf doesn't yet close");
  31
  32 # sock2 interrupts (maybe sock1 is slow) and deletes stuff:
  33 print $sock2 "delete big\r\n";
  34 is(scalar <$sock2>, "DELETED\r\n", "deleted big from sock2 while sock1's still reading it");
  35 mem_get_is($sock2, "big", undef, "nothing from sock2 now.  gone from namespace.");
  36 print $sock2 "set big 0 0 $size\r\n$bigval2\r\n";
  37 is(scalar <$sock2>, "STORED\r\n", "stored big w/ val2");
  38 mem_get_is($sock2, "big", $bigval2, "big value2 got correctly");
  39
  40 # sock1 resumes reading...
  41 $buf .= <$sock>;
  42 $buf .= <$sock>;
  43 like($buf, qr/abcde\]/, "buf now closes");
  44
  45 # and if sock1 reads again, it's the uppercase version:
  46 mem_get_is($sock, "big", $bigval2, "big value2 got correctly from sock1");