October 2008

Many years ago I wrote a simple perl+mysql polling script for work. It collected votes for multiple-choice polls, stored them in a database, and returned a results page. It was so simple and easy to use, we’ve continued using it for YEARS. Every so often we ask a question that is HIGHLY controversial (I’m looking at you NOW) and we are suddenly inundated with votes, causing much of the site to slow down or return errors.

The last time this happened I made some changes to the code that made it more difficult to vote more than once. Part of that involved storing the current vote totals in Memcached instead of asking the database each time. But even with that change, we’re still running a steady 3 or 4 votes per second and would be vulnerable to legitimate spikes in traffic from on-air promotion or something similar.

So today, I’ve reworked the script to run ALL traffic through memcached and NEVER hit the database at all unless memcached is completely unavailable. The basis for this is BroddlIT’s “memcached as simple message queue” at least as far as I can figure from his rough sketch.

The general idea is, there’s a lock, a pointer to the next slot in the queue, and the queue entries themselves.

Getting the lock

This waits up to a second to get the lock by sleeping for 1/1000th of a second between attempts. You can implement multiple queues by varying the $key_prefix. If the loop exits without getting the lock, you have to decide what to do.

  my $key_prefix = "poll-queue";
  my $total_sleep = 1000000;
  while($total_sleep > 0) {
    my $lock_key = $memd->incr("$key_prefix-lock");

    if(!defined $lock_key) { # No key in cache.
      $memd->set("$key_prefix-lock", $lock_key = 1);
      $memd->set("$key_prefix-curr", 0);
    } elsif($lock_key == 1) { # We got the lock.

    # Someone else has the lock, so wait 1/1000th of a second.
    $total_sleep -= usleep(1000);
  if($total_sleep <= 0) {
    # You didn't get the lock. Figure something out.

If you make sure you normally hold the lock for a very small amount of time, you can assume that waiting significantly longer than that without success gives you reasonable cause to take over the lock. The only trick there, as you might expect, is that you need to then release it before another process makes the same assumption.

Get Next Key Pointer

The $key_prefix-curr memcached key contains the index of the last entry in the queue. By calling the $memd->incr() method we get the next one and update the memcache at the same time. If for some reason the pointer doesn’t exist, it is created. The $key variable becomes the memcached key for this message.

  my $next_key = $memd->incr("$key_prefix-curr");
  if(!defined($next_key)) { $memd->set("$key_prefix-curr", 1); }
  my $key = sprintf("$key_prefix-key-%d", $next_key);

Store the Message in the Queue

Simple. Run this and the previous step in a loop to insert multiple values. But be careful because the lock is active, so the longer you take the longer you block other requests.

  $memd->set($key, $message);

Release the Lock

This releases the lock, which allows another process to insert its messages.

  $memd->set("$key_prefix-lock", 0);

Reading and Flushing the Queue

Obtain the lock in the same way as above, then get the $key_prefix-curr value and loop from 1. Just make sure you process the values after you release the lock so you don’t block new entries.

  my $last_key = $memd->get("$key_prefix-curr");
  for(my $i=1; $i<=$last_key; $i++) {
    my $key = sprintf("$key_prefix-key-%d", $i);
    push @messages, $memd->get($key);
  $memd->set("$key_prefix-curr", 0);
  $memd->set("$key_prefix-lock", 0);


So that’s it. It should require only Cache::Memcached and Time::HiRes.

Update: if you run multiple memcached daemons and connect to them all (allowing key-hash load balancing), you will probably want to set the “no_rehash” flag and add a bit more error checking. If you allow Cache::Memcached to re-hash your keys if a server connection fails, you could end up losing the various keys temporarily.

So you have a directory structure that contains all of the applications needed to run a set of servers, but no server needs the entire tree. This rsync configuration is the easiest way I can come up with to rsync only what is needed for a single server:

If /export/apps contains bin, lib, var, etc, share and sbin but you only want bin, lib, and one subdirectory of share rsynced, `hostname`-exclude-list.txt then looks like this:

+ /apps/bin/
+ /apps/lib/
+ /apps/share/vim/
- /apps/share/*
- /apps/*

Using this command, you can then sync the directories:

# rsync -avz --delete-excluded \
        --exclude-from=`hostname`-exclude-list.txt \
        /export/apps /local

With the --delete-excluded, if you change the exclude file, newly excluded entries will be removed from the destination. The copy will end up in /local/apps. More usefully, /export/apps could be on a remote server and the destination would be /export.

A method for randomly selecting N values from a finite (but unknown length) list of elements, without replacement. Algorithm is from Taming Uncertainty. This version takes lines of input on STDIN (or files on @ARGV) and selects 20 of them at random and prints the results to STDOUT.


use strict;
my $N = 20;
my $k;
my @r;

while(<>) {
  if(++$k <= $N) {
    push @r, $_;
  } elsif(rand(1) <= ($N/$k)) {
    $r[rand(@r)] = $_;

print @r;