sub leftover {
  my ($full, $part) = @_;
  my @count;
  $count[ord $1]++ while $full =~ /(\w)/g;
  while ($part =~ /(\w)/g) {
    return undef if --$count[ord $1] < 0;
  }
  my $return;
  $count[$_] and $return .= chr($_) x $count[$_] for 0..$#count;
  $return;
}
[download]

-- Randal L. Schwartz, Perl hacker

Thanks again merlyn. This one (l_merlyn2) was considerably slower than your original. A bit of it was the change to regex instead of split to process the strings. Mostly it was more expensive to build the return string. Since I only allow a..z, I changed for 0..$#count; to for (ord('a')..$#count); These changes (l_merlyn3) made it faster than the original.

l_merlyn: 16 wallclock secs (15.46 usr + 0.00 sys = 15.46 CPU) @ 6623.54/s (n=102400)
l_merlyn2: 24 wallclock secs (24.14 usr + 0.00 sys = 24.14 CPU) @ 4241.92/s (n=102400)
l_merlyn3: 15 wallclock secs (14.48 usr + 0.00 sys = 14.48 CPU) @ 7071.82/s (n=102400)