This subroutine takes a list of words as parameters and returns a list or string containing abbreviated versions of the words. It leaves words of 4 characters or fewer unchanged.
Note: This doesn't just generate truncated versions of a word, it attempts to generate a sensible abbreviation.
Update: Applied Ovid's change. Grab first char before lower casing string to retain case. Removed unused variable. Removed bogus readmore tags.
Sample test code.
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);
Sample output using original version of description text.
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
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;
}