open my $DICT, "<", "players" or die $!;
my (%words, %suffix, %prefix);
while (defined(my $word = <$DICT>)) {
    chomp $word;
    $word = lc $word;

    next unless $word =~ m/^[a-z]{2,}$/;
    next if $words{$word}++;

    push @{$suffix{substr $word, $_}}, $word
      for (1 .. length($word) - 1);
    push @{$prefix{substr $word, 0, $_}}, $word
      for (1 .. length($word) - 1);
}

#find_words("wozniacki"); find_words("zhou");

find_words($_)
  for sort keys %words;

sub find_words {
    my $word = shift;
    die "not a \"word\"" unless exists $words{$word};
    for my $idx (1 .. length($word) - 1) {
        my $prefix = substr $word, 0, $idx;
        my $suffix = substr $word, $idx;
        next unless exists $prefix{$prefix} && exists $suffix{$suffix}
+;

        my @pref_words = grep {$_ ne $word} @{$prefix{$prefix}};
        my @suff_words = grep {$_ ne $word} @{$suffix{$suffix}};
        next unless @pref_words && @suff_words;

        say $prefix, ".", $suffix;
        say "  PREFIX $prefix: @pref_words";
        say "  SUFFIX $suffix: @suff_words";
    }
}
[download]