Skip to content

Instantly share code, notes, and snippets.

@mix3
Created November 13, 2013 13:30
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mix3/7449132 to your computer and use it in GitHub Desktop.
Save mix3/7449132 to your computer and use it in GitHub Desktop.
#!/usr/bin/env perl
use strict;
use warnings;
use Test::TCP qw/empty_port wait_port/;
use File::Which qw/which/;
use Proc::Guard;
use Parallel::ForkManager;
use Storable;
use Cache::Memcached::Fast;
my ($proc, $port) = start_memcached();
my $memd = new Cache::Memcached::Fast({ servers => ['localhost:'.$port] });
$memd->set('test', 0);
my $pm = new Parallel::ForkManager(10);
for my $child (1..10) {
$pm->start and next;
my $memd = new Cache::Memcached::Fast({ servers => ['localhost:'.$port] });
for (1..1000) {
$memd->set('test', $memd->get('test') + 1);
}
$pm->finish and next;
}
$pm->wait_all_children;
print $memd->get('test'), "\n";
sub start_memcached {
my $port = empty_port();
my $proc = proc_guard(scalar(which 'memcached'), '-p', $port);
wait_port($port);
return $proc, $port;
}
#!/usr/bin/env perl
use strict;
use warnings;
use Test::TCP qw/empty_port wait_port/;
use File::Which qw/which/;
use Proc::Guard;
use Parallel::ForkManager;
use Storable;
use Cache::Memcached::Fast;
my ($proc, $port) = start_memcached();
my $memd = new Cache::Memcached::Fast({ servers => ['localhost:'.$port] });
$memd->set('test', 0);
my $pm = new Parallel::ForkManager(10);
for my $child (1..10) {
$pm->start and next;
my $memd = new Cache::Memcached::Fast({ servers => ['localhost:'.$port] });
for (1..1000) {
my $ret = $memd->gets('test');
my ($cas, $val) = @$ret;
$val++;
redo unless ($memd->cas('test', $cas, $val));
}
$pm->finish and next;
}
$pm->wait_all_children;
print $memd->get('test'), "\n";
sub start_memcached {
my $port = empty_port();
my $proc = proc_guard(scalar(which 'memcached'), '-p', $port);
wait_port($port);
return $proc, $port;
}
@mix3
Copy link
Author

mix3 commented Nov 13, 2013

$ perl no_cas.pl
2050

$ perl with_cas.pl
10000

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment