my %Words;

while (<>)
    {
    my @WordList = /(?:([\w']+)\W*)/g;
    my $Word;

    foreach $Word (@WordList)
        {
        next if $Word =~ /[\d\W_]/;
        next if length ($Word) <= 4;
        $Word = lc $Word;
        $Words {$Word} = Abbreviate ($Word);
        }
    }

print "$_ => $Words{$_}\n" foreach (sort keys %Words);