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);

##</code><code>##

abbrev => abrv
abbreviate => abrvt
abbreviated => abrvtd
aeiou => a
application => aplctn
characters => chrctrs
containing => cntnng
defined => dfnd
excluding => excldng
fewer => fwr
foreach => frch
input => inpt
leaves => lvs
length => lngth
output => otpt
parameters => prmtrs
print => prnt
readmore => rdmr
result => rslt
return => rtrn
returns => rtrns
sample => smpl
section => sctn
shift => shft
string => strng
subroutine => sbrtn
substr => sbstr
takes => tks
title => ttl
unchanged => unchngd
using => usng
versions => vrsns
wantarray => wntry
while => whl
wordlist => wrdlst
words => wrds

##</code><code>##

sub Abbreviate
{
my @Result;

while (local $_ = shift)
    {
    last if ! defined $_;
    my $Abbrev;

    $Abbrev = substr $_, 0, 1, "";
    if (length ($_) > 4)
        {
        tr/A-Z/a-z/;
        tr/a-z//cd;
        tr/aeiou//d;
        s/(.)\1+/$1/gi;
        s/ck/k/g;
        s/ptn/pn/g;
        s/tng/tg/g;
        s/thr/tr/g;
        s/vnt/vt/g;
        s/ltn/ln/g;
        s/lb/b/g;
        s/tt/t/g;
        }
        
    $Abbrev .= $_;
    push @Result, $Abbrev;
    }
    
return wantarray ? @Result : join " ", @Result;
}