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";
    }
}

##</code><code>##

woznia.cki
  PREFIX woznia: wozniak
  SUFFIX cki: lisicki
zh.ou
  PREFIX zh: zhang zhao zharkova zheng zhong
  SUFFIX ou: daniilidou fafaliou georgatou gerasimou
zho.u
  PREFIX zho: zhong
  SUFFIX u: anghelescu begu buzarnescu cadantu daniilidou dulgheru fafaliou georgatou gerasimou hincu hisamatsu hsu liu lu mitu nedelcu niculescu olaru perianu qiu radu senoglu shimizu stancu tigu vaideanu xu yu

##</code><code>##

real    0m0.266s
user    0m0.256s
sys     0m0.012s