use strict; use warnings; use Algorithm::Loops qw( NextPermute ); sub get_next_dict_word { my ($dict_fh) = @_; for (;;) { local $_ = <$dict_fh>; return $_ unless defined; my $first_letter = substr($_, 0, 1); return $_ if lc($first_letter) eq $first_letter; } } { die("Specify the word as an argument.$/") unless @ARGV; my $word = lc($ARGV[0]); # DICTIONARY MUST BE SORTED, ONE WORD PER LINE. # UPPERCASE WORDS ARE IGNORED. my $dict_fh; open($dict_fh, '<', '/usr/share/dict/words') or die("Can't open dictionary: $!$/"); my $dict_word = <$dict_fh>; chomp($dict_word) if defined $dict_word; my @list = sort ' ', $word =~ /(.)/g; my $last_permute = ''; while (NextPermute(@list)) { my $permute = join('', @list); $permute =~ s/ .*//; next if ($permute eq $last_permute); $last_permute = $permute; while (defined($dict_word) && $dict_word lt $permute) { $dict_word = <$dict_fh>; chomp($dict_word) if defined $dict_word; } if (defined($dict_word) && $permute eq $dict_word) { print("Found $permute$/"); $dict_word = <$dict_fh>; chomp($dict_word) if defined $dict_word; } else { print("Didn't find $permute$/"); } } } dictionary used --------------- apple dud dude dudette due orange output ------ Didn't find d Didn't find dd Didn't find dde Didn't find ddeu Didn't find ddu Didn't find ddue Didn't find de Didn't find ded Didn't find dedu Didn't find deu Didn't find deud Didn't find du Found dud Found dude Found due Didn't find dued Didn't find e Didn't find ed Didn't find edd Didn't find eddu Didn't find edu Didn't find edud Didn't find eu Didn't find eud Didn't find eudd Didn't find u Didn't find ud Didn't find udd Didn't find udde Didn't find ude Didn't find uded Didn't find ue Didn't find ued Didn't find uedd