I think you've got the right algorithm already, but you can use a few tricks to shave it down to a readable size. However, I notice that your script adds an additional condition that I don't handle below -- elements unlisted in @order are placed at the end of the list in dictionary order. Not sure if you require that or not.

my %order;
$order{$order[$_]} = @order-$_ for (0..$#order);
{
    local $^W=0;
    my @sorted = sort { $order{$b} <=> $order{$a} } @sortme;
}
[download]

or slightly slower, if you don't like mucking with warnings,

my %order;
$order{$order[$_]} = $_+1 for (0..$#order);
my @sorted = sort { ($order{$a}||@order) <=> ($order{$b}||@order) }
             @sortme;
[download]