#!/usr/bin/perl -w
#
# $Id: abbreviate,v 1.3 2008/03/31 00:50:49 vogelke Exp $
#
# http://www.perlmonks.org/index.pl?node_id=464885
#
# 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.

my %words;
my $word;

while (<DATA>) {
    chomp;
    next if /[\d\W_]/;
    next if length() <= 4;
    $word = lc($_);
    $words{$_} = abbreviate($word);
}

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


sub abbreviate {
    my @result;
    local $_;

    foreach (@_) {
        my $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;
}

__DATA__
abbrev
abbreviate
abbreviated
aeiou
application
characters
containing
defined
excluding
fewer
foreach
input
leaves
length
output
parameters
print
readmore
result
return
returns
sample
section
shift
string
subroutine
substr
takes
title
unchanged
using
versions
wantarray
while
wordlist
words