#!perl -l
use strict;
use warnings;

sub sort_word {
  return join '', sort split //, $_[0];
}

my %hints = (
    bumps => 2,
    seams => 2,
    domes => 3,
    shake => 3,
    pokes => 3,
    dukes => 3
);

my $wordlen = 5;

my %dict;
open(DICT, '/usr/dict/words') or die "$!: /usr/dict/words\n";
chomp, push @{$dict{sort_word($_)}}, $_ while (<DICT>);
close(DICT);


my $guess = 'a' x $wordlen;

sub letters_in_common {
  my ($str1, $str2) = @_;
  my %u = map {$_ => $_} split //, $str1;
  return scalar(grep defined, delete @u{split //, $str2});
}

while (length($guess) == $wordlen) {
  # Check criteria
  my $match = 1;
  while (my ($k,$v) = each %hints) {
    if (letters_in_common($guess, $k) != $v) {
      $match = 0;
      keys %hints; # Reset each
      last;
    }
  }
  # If match, check dictionary and print results. Done!
  # Otherwise, increment guess
  if ($match) {
    if (exists($dict{$guess})) {    print "Solution(s): @{$dict{$guess}}"; last  }
    else { print "No words match qualifying guess $guess"; }
  }
  ++$guess;
  # Short-circuit: only keep guesses that are sorted
  # So when the last char flips to an a, flip the trailing
  # string of last chars to a repetition of the rightmost
  # non-a
  $guess =~ s/([^a])(a+)$/$1 x (length($2)+1)/e;
}